perm filename PIXFAI.FAI[S,HE] blob sn#566351 filedate 1981-02-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00049 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002		TITLE	PIXSUB
C00006 00003	MAKTAB:	POP	P,RETAD
C00007 00004	PIXEL:	POP	P,RETAD
C00008 00005	INTREL:	POP	P,RETAD      like PIXEL, but interpolates
C00010 00006	PUTEL:	POP	P,RETAD
C00011 00007	ADDEL:	POP	P,RETAD
C00012 00008	ADDIEL:	POP	P,RETAD      like ADDEL, but interpolates
C00017 00009	% All this has been laid to rest the hardware no longer exists.
C00027 00010		TITLE	WIPE		ERASE A PICTURE
C00029 00011	PICADD:	POP	P,RETAD		ADD TWO PICTURES
C00030 00012	PICSUB:	POP	P,RETAD		SUBTRACT TWO PICTURES
C00031 00013	PICMUL:	POP	P,RETAD		MULTIPLY TWO PICTURES
C00032 00014	PICDIV:	POP	P,RETAD		DIVIDE TWO PICTURES (added by pb 2/23/81)
C00034 00015	PICSH:	POP	P,RETAD		RANGE CHANGE
C00035 00016	TVBTMY: MOVE	T,[CAIG T,7]	 TVBTMY(PIC,DEST,XFRM,INHIBLE)
C00037 00017		TITLE	GRAY
C00039 00018		TITLE	SHRINK
C00042 00019		TITLE	BITHAF		reduce bits/sample with halftoning algorithm
C00044 00020		TITLE	COPPIC
C00046 00021		TITLE	WIXFAI
C00048 00022	AR2TAB:	MOVEI	T,1
C00051 00023	HAFPIC:	POP	P,RETAD
C00055 00024	GETPAR:	POP	P,RETAD
C00056 00025	PUTPAR:	POP	P,RETAD
C00057 00026	LOWPAS:	POP	P,RETAD
C00058 00027	PERBIT:	POP	P,RETAD
C00059 00028	HISTOG:	POP	P,RETAD
C00061 00029	COLSUM:	POP	P,RETAD
C00062 00030	ROWSUM:	POP	P,RETAD
C00063 00031	SUMSQR:	POP	P,RETAD		sum of squares of pixels, double precision real
C00065 00032	NOISE:	POP	P,RETAD  calculates sum(x[i+1,j]-x[i,j])↑2/sum(x-xbar)↑2
C00067 00033	UNPACK:	POP	P,RETAD	 UNPACK A DENSE BYTE ARRAY INTO A PICTURE
C00068 00034	 TILE(PIC1,YL1,XL1, TY,TX, PIC2,YL2,XL2)
C00072 00035	ROWSUD:	POP	P,RETAD			much quicker and dirtier than ROWSUM
C00078 00036	DEFINE SHFT1 <TEMP+1>
C00080 00037	CMPPAD:	POP	P,RETAD
C00081 00038		TITLE	CENTRO
C00086 00039		TITLE	INTOP
C00090 00040		INTLOM(VER,HOR,ARRY)		INTEREST OPERATOR LOCAL MXIMUM TEST
C00095 00041		TITLE	MATCH
C00106 00042		TITLE	NORCOR
C00117 00043		title pixtrn
C00122 00044		TITLE	WIXFA1
C00125 00045	CLN:	0
C00126 00046	HIPASS:	0			HI PASS FILTERING
C00129 00047	***** WIXFA1 SAIL INTERFACE ********
C00131 00048	CLEAN:	MOVEM	12,ACS12
C00132 00049		TITLE	TEMP
C00133 ENDMK
C⊗;
	TITLE	PIXSUB
	ENTRY	MAKTAB,PIXEL,PUTEL,ADDIEL,ADDEL,INTREL
	EXTERN	CORGET,CORREL
	I←1
	J←2
	K←3
	II←T←4
	JJ←M←5
	AR←6
	A←7
	B←10
	C←11

	D←13
        V←14
	P←17

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←13
LINTAB←←14
%

RETAD:	0
MAKTAB:	POP	P,RETAD
	POP	P,AR
	MOVEI	I,LINTAB(AR)
	HRRM	I,RWLP
	MOVN	I,PCLN(AR)	;USED INTERNALLY TO GENERATE LINE AND
	HRLZ	I,I		;BYTE TABLES
	MOVE	J,AR
	ADD	J,PCLN(AR)
	ADD	J,LNBYA(AR)
	ADDI	J,15
RWLP:	MOVEM	J,LINTAB(I)	;REPLACED BY ACTUAL ADR OF THE LINE TABLE
	ADD	J,LNWD(AR)
	AOBJN	I,RWLP
	
	MOVE	J,BYBI(AR)
	LSH	J,30
	SUBI	J,1
	MOVE	I,BPTAB(AR)
	HRRM	I,COLP
	MOVEM	J,-1(I)
	MOVEI	J,44
	SUB	J,BYBI(AR)
	LSH	J,6
	OR	J,BYBI(AR)
	LSH	J,30
	MOVN	I,LNBYA(AR)
	HRLZ	I,I
COLP:	MOVEM	J,BPTAB(I)	;REPLACED BY ACTUAL ADR OF BYTE TABLE
	IBP	J
	AOBJN	I,COLP
	JRST	@RETAD
PIXEL:	POP	P,RETAD
	POP	P,J
	POP	P,I
	POP	P,AR
        CAIGE	I,0
	MOVEI	I,0
	CAIGE	J,0
	MOVEI	J,0
	CAML	I,PCLN(AR)
 	SOJA	I,.-1
	CAML	J,LNBY(AR)
	SOJA	J,.-1
	MOVEI	K,LINTAB(AR)
	HRRM	K,LNTB
	MOVE	K,BPTAB(AR)
	HRRM	K,BPTB
LNTB:	MOVE	K,LINTAB(I)
BPTB:	ADD	K,BPTAB(J)
	LDB	1,K
	JRST	@RETAD
INTREL:	POP	P,RETAD     ; like PIXEL, but interpolates
	POP	P,J	    ; I, J and result are floating point
	POP	P,I
	POP	P,AR
        CAIGE	I,0
        MOVEI	I,0
	CAIGE	J,0
	MOVEI	J,0
	FLTR	T,PCLN(AR)
	FSBR	T,[1.0001]
	CAMLE	I,T
	MOVE	I,T
	FLTR	T,LNBY(AR)
	FSBR	T,[1.0001]
	CAMLE	J,T
	MOVE	J,T
	KIFIX	II,I
	KIFIX	JJ,J

	MOVEI	K,LINTAB(AR)
	HRRM	K,LNTBI
	MOVE	K,BPTAB(AR)
	HRRM	K,BPTBI
LNTBI:	MOVE	K,LINTAB(II)
BPTBI:	ADD	K,BPTAB(JJ)
	LDB	A,K
	ADD	K,LNWD(AR)
	LDB	C,K
	ILDB	D,K
	SUB	K,LNWD(AR)
	LDB	B,K
	FLTR	A,A
	FLTR	B,B
	FLTR	C,C
	FLTR	D,D
	FLTR	II,II
	FLTR	JJ,JJ
	FSBR	I,II
	FSBR	J,JJ
	FSBR	B,A
	FMPR	B,J
	FADR	A,B
	FSBR	D,C
	FMPR	D,J
	FADR	C,D
	FSBR	C,A
	FMPR	C,I
	FADR	A,C
	MOVE	1,A

	JRST	@RETAD
PUTEL:	POP	P,RETAD
	POP	P,M
	POP	P,J
	POP	P,I
	POP	P,AR
        CAIL	I,0
	CAIGE	J,0
	JRST	@RETAD
	CAMGE	I,PCLN(AR)
	CAML	J,LNBY(AR)
	JRST	@RETAD
	MOVEI	K,LINTAB(AR)
	HRRM	K,LNTB1
	MOVE	K,BPTAB(AR)
	HRRM	K,BPTB1
LNTB1:	MOVE	K,LINTAB(I)
BPTB1:	ADD	K,BPTAB(J)
	DPB	M,K
	JRST	@RETAD
ADDEL:	POP	P,RETAD
	POP	P,M
	POP	P,J
	POP	P,I
	POP	P,AR
        CAIL	I,0
	CAIGE	J,0
	JRST	@RETAD
	CAMGE	I,PCLN(AR)
	CAML	J,LNBY(AR)
	JRST	@RETAD
	MOVEI	K,LINTAB(AR)
	HRRM	K,LNTB2
	MOVE	K,BPTAB(AR)
	HRRM	K,BPTB2
LNTB2:	MOVE	K,LINTAB(I)
BPTB2:	ADD	K,BPTAB(J)
	LDB	A,K
	CAMGE	A,BMAX(AR)
	ADD	A,M
	DPB	A,K
	JRST	@RETAD
;ADDIEL:	POP	P,RETAD     ; like ADDEL, but interpolates
; V holds "brightness", floating point.
; I holds y-position in pixels, floating point.
; J holds x-position in pixels, floating point.
; AR holds picture address.
ADDIEL:	POP	P,RETAD     ; like ADDEL, but interpolates
	POP	P,V
	POP	P,J	    ; I, J and value are floating point
	POP	P,I
	POP	P,AR
        CAIL	I,0		; Check that X and Y are both > 0.
	CAIGE	J,0
	JRST	@RETAD		;  nope--return
	FLTR	T,PCLN(AR)
	FSBR	T,[1.0001]
	CAMLE	I,T		; Check that Y is ≤ (no. lines)-ε
	JRST	@RETAD		;  nope--return
	FLTR	T,LNBY(AR)
	FSBR	T,[1.0001]
	CAMLE	J,T		; Check that X is ≤ (no. bytes)-ε
	JRST	@RETAD		;  nope--return
	KIFIX	II,I		; KIFIX truncates, not rounds.
	KIFIX	JJ,J

	MOVEI	K,LINTAB(AR)	; Make a byte pointer to the upper left of
	HRRM	K,LNTBP		;  the four pixels that will be modified.
	MOVE	K,BPTAB(AR)
	HRRM	K,BPTBP
LNTBP:	MOVE	K,LINTAB(II)
BPTBP:	ADD	K,BPTAB(JJ)
	FLTR	II,II
	FLTR	JJ,JJ
	FSBR	I,II		; I gets fractional part of y-value, and
	FSBR	J,JJ		; J gets fractional part of x-value

; What happens next is that the accumulators A, B, C, and D are set up so that
;  they contain the integers to be added to the four-pixel block pointed to by
;  K, in the following configuration:
;			K-->A B
;			    C D
;  in other words, K points to the byte which must be incremented by the contents
;  of A and so on.

	MOVE	B,J		; This is all H. P. Magic
	MOVE	C,I
	MOVE	D,I	; Everything makes sense when you use the following rule:
	FMPR	D,J	;  The portion of the "brightness" that a pixel gets is
	FSBR	B,D	;  equal to (1 - its x-distance from the point) times (1 - 
	FSBR	C,D	;  its y-distance from the point).  Here, I is the y-dist-
			;  ance from A, and J is the x-distance from A, so the
	FIXR	A,V	;  portions of V are:
			;    A = (1-I)(1-J) = 1-I-J-IJ
	FMPR	B,V	;    B = (1-I)J = J-IJ
	FMPR	C,V	;    C = (1-J)I = I-IJ
	FMPR	D,V	;    D = IJ
	FIXR	B,B	;  So this is implemented by taking D=IJ, C=I-D, B=J-D,
	FIXR	C,C	;  and A=1-B-C-D, and multiplying them all by V then
	FIXR	D,D	;  rounding them off to integral values.

	SUB	A,B
	SUB	A,C
	SUB	A,D		; End of magical incantations

	LDB	T,K			; Now do the updating...K points to "A"
	ADD	T,A
	CAIGE	T,0			; Don't store a negative
	MOVEI	T,0
	CAMLE	T,BMAX(AR)		;  or too big a value
	MOVE	T,BMAX(AR)
	DPB	T,K

	ADD	K,LNWD(AR)		; "C" is on the next line, LNWD words away
	LDB	T,K
	ADD	T,C
	CAIGE	T,0
	MOVEI	T,0
	CAMLE	T,BMAX(AR)
	MOVE	T,BMAX(AR)
	DPB	T,K

	ILDB	T,K			; Increment the pointer to get to "D"
	ADD	T,D
	CAIGE	T,0
	MOVEI	T,0
	CAMLE	T,BMAX(AR)
	MOVE	T,BMAX(AR)
	DPB	T,K

	SUB	K,LNWD(AR)		; "B" is on the previous line
	LDB	T,K
	ADD	T,B
	CAIGE	T,0
	MOVEI	T,0
	CAMLE	T,BMAX(AR)
	MOVE	T,BMAX(AR)
	DPB	T,K

	JRST	@RETAD

	PRGEND
COMMENT % All this has been laid to rest; the hardware no longer exists.

	TITLE	TVSNAP
	ENTRY	TVSNAP,TVRAW,TVGRY,bufget,bufrel
	EXTERN	CORGET,CORREL,TEMP

	I←1
	J←2
	K←3
	T←4
	M←5
	AR←6
	A←7
	B←10
	C←11

	P←17

PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←←13
LINTAB←←14

DEFINE	RETAD	<TEMP>

DEFINE  TVBLOK	<TEMP+1>  ;	0,,0	    ; -WC,,ARRDESS OF DATA
        ;	<TEMP+2>	0,,703002   ; B T C V 1 H
	;	<TEMP+3>	0,,042	    ; YDI,,XDI 000
	;	<TEMP+4>	0

DEFINE	YDISP	<TEMP+5>
DEFINE	RETRY	<TEMP+6>
DEFINE	NTRY	<TEMP+7>	; NTRY argument, absolute value
DEFINE	RAWF	<TEMP+10>
DEFINE	RTMAX	<TEMP+11>
DEFINE	ONETRY	<TEMP+12>	; NTRY argument, actual value
DEFINE	SGNM  	<TEMP+13>

; GREY: 12 ↔ 13 ↔ 11 ↔ 10 ↔ 15 ↔ 14 ↔ 16 ↔ 17 ↔ 5 ↔ 4 ↔ 6 ↔ 7 ↔ 2 ↔ 3 ↔ 1 ↔ 0

bufget:	pop	p,retad		;get tv buffer for many pictures together
bffinsh:CHNSTS	1,A
	JUMPE	A,bufcon
	 movem	A,astats
	 IOPUSH	1,1
	  HALT
bufcon:	movei	k,42303		;extremely ugly!!
	peek	k,		;get fstop
	addi	k,50640		;also very ugly
	addi	k,30		;this too
	camle	k,fstlim	;if over this, wait for free storage to come up
	  jrst	bufwat
	
	INIT	1,417
	SIXBIT	/TV/
	0
        JRST   bfnotv		;not available
        JRST   bftvav
bfnotv: OUTSTR [ASCIZ /
Waiting for TV
/]
	INIT 1,1017		;automatic wait for device
	SIXBIT /TV/
	0
	HALT
bftvav:	setom	bufflg		;say buffer obtained
	skipe	watmsg
	  outstr [asciz/ gotcha!
/]
	setzm	watmsg
	jrst	@retad

bufwat:	skipe	watmsg		;saying waiting yet?
	  jrst	.+3		;yes
	setom	watmsg
	outstr	[asciz/
waiting for TV buffer -/]
	movei	k,0		;wait a sixtieth then try again
	sleep	k,
	jrst	bufcon

bufrel:	RELEAS	1,		;release tv buffer now
	move	A,astats	;prior channel status
	JUMPE	A,bufrl2
	IOPOP	1,1
	JRST	.+1
bufrl2:	setzm	bufflg		;and say buffer released
	popj	p,

TVRAW:	SETOM	RAWF		;TVRAW FOR NO GREY CODE CONVERSION,
	JRST	TVSNAP+1	;TVSNAP OTHERWISE
TVSNAP:	SETZM	RAWF
	POP	P,RETAD
	POP	P,T
	MOVEM	T,ONETRY
	MOVMM	T,NTRY
	POP	P,T       ;TVSNAP(CAM,YEDG,XEDG,PIC,BCLIP,TCLIP,NTRY)
	POP	P,B	  ;
	POP	P,AR
	POP	P,J
	POP	P,I
	POP	P,K		;GENERATE B T C V 1 H WORD
	LSH	B,3
	OR	B,T
	LSH	B,3
	OR	B,K
	LSH	B,11
	ORI	B,2
	MOVEM	B,TVBLOK+1

	MOVEM	I,YDISP
	HRLZ	I,I		;GENERATE YDI XDI,,WID 000 WORD
	HRLZ	J,J
	OR	I,LNWD(AR)
	LSH	I,11
	OR	I,J
	MOVEM	I,TVBLOK+2

	MOVN	T,PCWD(AR)	;GENERATE -WC,,ADDR
	HRLZ	T,T
	HRR	T,LINTAB(AR)
	MOVEM	T,TVBLOK

	MOVEI	T,374
	SUB	T,YDISP
	IMUL	T,LNWD(AR)	;TO PREVENT RETRIES STARTING AFTER THE
	ADD	T,LINTAB(AR)	;770'TH LINE. THE FIELD FOR SPECIFYING
	MOVEM	T,RTMAX		;THIS IS ONLY 777 WIDE

FINSH:	skipe	bufflg		;dont save if holding buffer
	  jrst	fstcon		;holding buffer
	CHNSTS	1,A
	JUMPE	A,.+3
	IOPUSH	1,1
	HALT

fstcon:	skipe	bufflg		;buffer here already?
	  jrst	tvav1		;yes
	movei	k,42303		;extremely ugly!!
	peek	k,		;get fstop
	addi	k,50640		;also very ugly
	addi	k,30		;this too
	camle	k,fstlim	;if over this, wait for free storage to come up
	  jrst	fstwat
	
	INIT	1,417
	SIXBIT	/TV/
	0
        JRST   NOTV		;not available
        JRST   TVAV1
NOTV:  OUTSTR [ASCIZ /
Waiting for TV
/]
	INIT 1,1017		;automatic wait for device
	SIXBIT /TV/
	0
	HALT

TVAV1:	SETZM	RETRY		; zero return value
TVAV:	SETSTS	1,117

        MOVEI	K,0		;"Jobs with upper segments are not allowed to lock
	SEGNUM	K,		; themselves in core"--UUO manual, p. 149
	MOVEM	K,SGNM
	DETSEG
	LOCK

	MOVEI	T,324	;**** this is JBTPAG, let's hope WAITS never changes...
	PEEK	T,
	PJOB	K,
	ADD	T,K
	PEEK	T,
	INPUT	1,TVBLOK

	UNLOCK
	MOVE	K,SGNM
	ATTSEG	K,
	JRST	.+1

	MOVE	I,TVBLOK+3

 
;	TRNN	I,20
;	JRST	NXB
;	OUTSTR	[ASCIZ /TV NXM /]
;	JRST	NXA
;NXB:	OUTSTR	[ASCIZ / TV OK /]
;NXA:	MOVE	J,I
;	LSH	T,=27
;	ADD	J,T
;	MOVEI	K,=12
;ERLP:	HLLZ	T,J
;	LSH	J,3
;	TLZ	T,77777
;	LSH	T,-4
;	TLO	T,300000
;	OUTSTR	T
;	CAIN	K,7
;	OUTSTR	[ASCIZ /,,/]
;	SOJG	K,ERLP
;	OUTSTR	[ASCIZ /
;/]

NONXM:	SKIPL	ONETRY		;If the NTRY argument was non-negative, and
	TRNN	I,40		; the error bit of the 167 bit was set, then
	JRST	TVNM		; do a partial retry.  Either condition false → TVNM

	HLRZ	J,I		;PARTIAL SUCCESS, TRY TO GET REST OF DATA
      add j,lintab(ar)	;WAITS seems to return offset, not core loc.--AAM 6/5/80
      subi j,1		;?? not sure--trying to get rid of black bars in pic.
	CAMLE	J,RTMAX		;MAKE SURE PICTURE BOUNDARY IS NOT
	MOVE	J,RTMAX		;EXCEEDED
	SUB	J,LINTAB(AR)	;CALCULATE NEW Y OFFSET
	IDIV	J,LNWD(AR)	;NEW REDUCED NUMBER OF WORDS AND
 	MOVE	K,TVBLOK+2	;NEW INCREASED STARTING ADDRESS IN BUFFER
	ROT	K,11
	ANDCMI	K,777
	ADD	K,J
	ADD	K,J
	ADD	K,YDISP
	ROT	K,-11
	MOVEM	K,TVBLOK+2
	IMUL	J,LNWD(AR)
	MOVE	K,J
	ADD	J,LINTAB(AR)
	SUB	K,PCWD(AR)
	HRL	J,K
	MOVEM	J,TVBLOK
	AOS	RETRY		;note that since ONETRY is never changed, partial
	JRST	TVAV		; retries can continue forever.

TVNM:	TRNN	I,10		; 167 error bit set?
	JRST	[SOSGE	NTRY	;  yes, any retries left?
		JRST	[SETOM	RETRY	;nope.  -1 return value means failure.
			 JRST	TVOK]
		AOS	RETRY	;  yes.  return value means number of retries.
		JRST	TVAV	       ]

TVOK:	skipe	bufflg		;give up buffer?
	  jrst	tvok2		;no
	RELEAS	1,
	JUMPE	A,tvok2
	IOPOP	1,1
	JRST	.+1

tvok2:	SKIPL	RAWF
	SKIPGE	NTRY
	JRST	TVDUN

TVG:	MOVN	I,PCWD(AR)		;GREY CODE CONVERSION
	MOVE	J,LINTAB(AR)
	HRL	J,I
	MOVE	I,[BYTE (4) 7,7,7,7,7,7,7,7,7]
	MOVE	M,[BYTE (4) 3,3,3,3,3,3,3,3,3]
GCL:	SETCM	T,(J)	;| ¬A  | ¬B     | ¬C        | ¬D           |
	MOVE	K,T     ;|     |        |           |              |
	LSH	K,-1	;|     |    ¬A  |    ¬B     |    ¬C        |
	AND	K,I	;|     |        |           |              |
	XORB	T,K	;| ¬A  | ¬B⊗¬A  | ¬C⊗¬B     | ¬D⊗¬C        |
	LSH	K,-2	;|     |        |       ¬A  |       ¬B⊗¬A  |
	AND	K,M	;|     |        |           |              |
	XOR	T,K	;| ¬A  | ¬B⊗¬A  | ¬C⊗¬B⊗¬A  | ¬D⊗¬C⊗¬B⊗¬A  |
	MOVEM	T,(J)
	AOBJN	J,GCL

TVDUN:	MOVE	1,RETRY

	JRST	@RETAD

TVGRY:	POP	P,RETAD
	POP	P,AR
        JRST	TVG

fstwat:	movei	k,0	;wait a sixtieth then try again
	sleep	k,
	jrst	fstcon
fstlim:	oct	620000	;free storage lim

astats:	0		;channel prior status
watmsg:	0		;messsage about waiting
bufflg:	0		;buffer holding flag
        PRGEND
All gone.  Sorry Hans   1-20-81 AAM %
	TITLE	WIPE		;ERASE A PICTURE
	ENTRY	WIPE,PICADD,PICMUL,PICDIV,PICSUB,TVBTMX,TVBTMY,TVBTMZ,PICSH
	EXTERN	CORGET,CORREL,TEMP

DEFINE RETAD <TEMP>
DEFINE XTAB <TEMP+1>


SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
        BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

THIS←←TT ↔ SIZ←←TTT

WIPE:	POP	P,RETAD			;CLEARS A PICTURE IN PIC1
	POP	P,G			;VALUE
	POP	P,ARRY1	
	MOVE	T,LINTAB(ARRY1)			;  WIPE(PIC,VALUE)
	HRL	T,T
	HRRZ	TT,T
	MOVEM	G,(TT)
	ADDI	T,1
	ADD	TT,PCWD(ARRY1)
	SUBI	TT,1
	BLT	T,(TT)
	JRST	@RETAD
PICADD:	POP	P,RETAD		;ADD TWO PICTURES
	POP	P,ARRY2
	POP	P,ARRY1		; PICADD(PIC1, PICSUM)

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

PLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
PCLP:	ILDB	T,F
	ILDB	TT,G
	ADD	TT,T
	DPB	TT,G
	SOJG	E,PCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,PLLP

	JRST	@RETAD
PICSUB:	POP	P,RETAD		;SUBTRACT TWO PICTURES
	POP	P,ARRY2
	POP	P,ARRY1		; PICSUB(PIC1, PIC2)  PIC2←PIC1-PIC2

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

SPLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
SPCLP:	ILDB	T,F
	ILDB	TT,G
	SUB	T,TT
	DPB	TT,G
	SOJG	E,SPCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,SPLLP

	JRST	@RETAD
PICMUL:	POP	P,RETAD		;MULTIPLY TWO PICTURES
	POP	P,ARRY2
	POP	P,ARRY1		; PICMUL(PIC1, PICSUM)

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

MPLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
MPCLP:	ILDB	T,F
	ILDB	TT,G
	IMUL	TT,T
	DPB	TT,G
	SOJG	E,MPCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,MPLLP

	JRST	@RETAD
PICDIV:	POP	P,RETAD		;DIVIDE TWO PICTURES (added by pb 2/23/81)
	POP	P,TTT		;NORMALIZATION FACTOR (REAL)
	POP	P,ARRY2
 	POP	P,ARRY1		; PICDIV(PIC, DIVPIC,NORM)

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

DVLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
DVCLP:	ILDB	T,F
	JUMPE	T,CTEST		;NUMERATOR=0 ==> ANSWER=0
	ILDB	TT,G
	FLTR	T,T
	FLTR	TT,TT
	FDVR	T,TT
	FMPR	T,TTT		;NORMALIZE BY GIVEN FACTOR
	FIXR	T,T
	CAIN	TT,0		;DID WE DIV BY 0?
	SETO	T		;YES--MAKE ANSWER ALL 1'S
	DPB	T,F		;RESULT IN ARRY1
CTEST:	SOJG	E,DVCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,DVLLP

	JRST	@RETAD
PICSH:	POP	P,RETAD		;RANGE CHANGE
	POP	P,TTT
	POP	P,ARRY2
	POP	P,ARRY1		; PICSH(PIC1, PICSUM, DIV)

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

PSLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
PSCLP:	ILDB	T,F
	IDIV	T,TTT
	IDPB	T,G
	SOJG	E,PSCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,PSLLP

	JRST	@RETAD
TVBTMY: MOVE	T,[CAIG T,7]	; TVBTMY(PIC,DEST,XFRM,INHIBLE)
	JRST	TVBT
TVBTMZ:	MOVE	T,[CAIL T,7]	; TVBTMZ(PIC,DEST,XFRM,INHIBGE)
	JRST	TVBT
TVBTMX: MOVE	T,[CAIN	T,7]	; TVBTMX(PIC,DEST,XFRM,INHIBEQ)
TVBT:	MOVEM	T,TVF
	POP	P,RETAD		;MIX A CLIPPED 4 BIT INT A MANY BIT PICTURE
	POP	P,T		;TOP VALUE
	HRRM	T,TVF
	POP	P,G		;XFORM TABLE
	POP	P,ARRY2		;DEST ARRAY
	POP	P,ARRY1
	HRRM	G,XFT

	MOVE	T,BPTAB(ARRY1)
	MOVE	A,-1(T)
	ADD	A,LINTAB(ARRY1)

	MOVE	T,BPTAB(ARRY2)
	MOVE	B,-1(T)
	ADD	B,LINTAB(ARRY2)

	MOVE	C,PCLN(ARRY1)
	CAMLE	C,PCLN(ARRY2)
	MOVE	C,PCLN(ARRY2)
	MOVE	D,LNBY(ARRY1)
	CAMLE	D,LNBY(ARRY2)
	MOVE	D,LNBY(ARRY2)

XPLLP:	MOVE	E,D
	MOVE	F,A
	MOVE	G,B
XPCLP:	ILDB	T,F
TVF:	CAIN	T,7
	JRST	[    IBP     G
                     SOJG    E,XPCLP
                     ADD     A,LNWD(ARRY1)
                     ADD     B,LNWD(ARRY2)
                     SOJG    C,XPLLP
                     JRST    @RETAD  ]
XFT:	MOVE	T,(T)		;CHANGED TO XFRM(T)
	IDPB	T,G
	SOJG	E,XPCLP
	ADD	A,LNWD(ARRY1)
	ADD	B,LNWD(ARRY2)
	SOJG	C,XPLLP

	JRST	@RETAD

	PRGEND
	TITLE	GRAY
	ENTRY	GRAY,UNGRAY
	EXTERN	TEMP

	I←1
	J←2
	K←3
	T←4
	M←5
	AR←6
	A←7
	B←10
	C←11

	P←17

DEFINE RETAD <TEMP>

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←13
LINTAB←←14
%

GRAY:	POP	P,RETAD		;Convert all the pixels in a picture
	POP	P,AR		;to Gray code representation  GRAY(PICT)

	MOVEI	M,0
	HRLZI	T,400000
	MOVN	C,BYBI(AR)
MMH:	LSH	T,(C)		;MAKE A LOW ORDER BIT MASK
	OR	M,T
	JUMPG	T,MMH

	MOVE	I,PCWD(AR)
	MOVE	J,LINTAB(AR)

TOGR:	MOVE	T,(J)
	LSH	T,-1
	ANDCM	T,M
	XORM	T,(J)
    	ADDI	J,1
	SOJG	I,TOGR		; no AOBJN because count can exceed 2↑17

	JRST	@RETAD


UNGRAY:	POP	P,RETAD		;Convert all the pixels in a Gray coded picture
	POP	P,AR		;to binary representation  UNGRAY(PICT)

	MOVEI	M,0
	HRLZI	T,400000
	MOVN	C,BYBI(AR)
MMHU:	LSH	T,(C)		;MAKE A HIGH ORDER BIT MASK
	OR	M,T
	JUMPG	T,MMHU

	MOVE	I,PCWD(AR)
	MOVE	J,LINTAB(AR)

FRGR:	MOVE	T,(J)
UNGL:	LSH	T,-1
	ANDCM	T,M
	XORM	T,(J)
	JUMPN	T,UNGL
    	ADDI	J,1		;can't use AOBJN because count can exceed 2↑17
	SOJG	I,FRGR

	JRST	@RETAD

	PRGEND
	TITLE	SHRINK
	ENTRY	SHRINK
	EXTERN	CORGET,CORREL,TEMP

DEFINE RETAD <TEMP>
DEFINE XTAB <TEMP+1>


SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
        BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

THIS←←TT ↔ SIZ←←TTT

SHRINK: POP	P,RETAD
	POP	P,ARRY2
	POP	P,ARRY1

	HRLZ	T,LNBY(ARRY1)	;FIGURE HOW MANY PIXELS IN X OF ARRY1
	IDIV	T,LNBY(ARRY2)	;GO INTO ARRY2
	MOVE	SIZ,LNBY(ARRY2)	;MAKE A BPTR TABLE ENTRY FOR ARRY2
	PUSHJ	P,CORGET	;GET CORE FOR IT
	HALT
	MOVEM	THIS,XTAB	;SAVE BPTR ADDRESSES
	MOVN	A,LNBY(ARRY2)	;SET UP COUNT
	HRL	THIS,A

	HRLZ	B,BPTAB(ARRY1)	;ADDRESS OF BPTR TABLE OF PIC1
	MOVE	F,T
	ASH	F,-1
	ADD	B,F

LNLP:	HLRZ	C,B		;GET INTEGER PART
	MOVE	C,(C)		;GET ITS POINTER
	MOVEM	C,(THIS)	;SAVE IT IN XTABLE
	ADD	B,T		;FIND NEXT ADDRESS
	AOBJN	THIS,LNLP	;AND LOOP

	MOVE	G,BYBI(ARRY2)	;CALCULATE RELATIVE SHIFT COUNT
	SUB	G,BYBI(ARRY1)

	HRLZ	T,PCLN(ARRY1)	;CALCULATE PARAMETERS FOR Y LOOP
	IDIV	T,PCLN(ARRY2)

	MOVN	A,PCLN(ARRY2)	;SET UP COUNT

	HRLZI	B,LINTAB(ARRY1) ;RAW BYTE PNTR FOR ARRY1
	MOVE	F,T
	ASH	F,-1
	ADD	B,F

	MOVE	E,BPTAB(ARRY2)	;RAW BYTE PTR FOR ARRY2
	MOVE	E,-1(E)
	ADD	E,LINTAB(ARRY2)

COLP:	HLRZ	D,B
	MOVE	D,(D)		;CORRECTED BYTE PTR FOR ARRY1
	MOVE	C,E		;ACTUAL BYTE PTR FOR ARRY2
	MOVN	TT,LNBY(ARRY2)	;INNER LOOP COUNTER ON BYTES/LINE
	HRLZ	TT,TT
	HRR	TT,XTAB
ILNP:	MOVE	TTT,(TT)
	ADD	TTT,D
	LDB	F,TTT
	LSH	F,(G)
	IDPB	F,C
	AOBJN	TT,ILNP
	ADD	B,T
	ADD	E,LNWD(ARRY2)
	AOJL	A,COLP

	MOVE	THIS,XTAB
	PUSHJ	P,CORREL
	JRST	@RETAD

	PRGEND
	TITLE	BITHAF		;reduce bits/sample with halftoning algorithm
	ENTRY	BITHAF
	EXTERN	CORGET,CORREL,TEMP

DEFINE RETAD <TEMP>
DEFINE XTAB <TEMP+1>


SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
        BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  BITSIZ←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

THIS←←TT ↔ SIZ←←TTT

BITHAF: POP	P,RETAD		;BITHAF(ARRY1,NEWBITSIZ);
	POP	P,BITSIZ
	POP	P,ARRY1

        MOVEI	SIZ,LNBY(ARRY1) ;GET CORE FOR ADJUSTED PIXEL
	PUSHJ	P,CORGET	;VALUES
	HALT
	MOVEM	THIS,XTAB	;SAVE ADDRESS OF ARRAY
	MOVN	A,LNBY(ARRY1)	;SET UP COUNT
	HRL	THIS,A

	HRLZ	B,BPTAB(ARRY1)	;ADDRESS OF BPTR TABLE OF PIC1
	MOVE	F,T
	ASH	F,-1
	ADD	B,F

COLP:	HLRZ	D,B
	MOVE	D,(D)		;CORRECTED BYTE PTR FOR ARRY1
	MOVE	C,E		;ACTUAL BYTE PTR FOR ARRY2
	MOVN	TT,LNBY(ARRY1)	;INNER LOOP COUNTER ON BYTES/LINE
	HRLZ	TT,TT
	HRR	TT,XTAB
ILNP:	MOVE	TTT,(TT)
	ADD	TTT,D
	LDB	F,TTT
	LSH	F,(G)
	IDPB	F,C
	AOBJN	TT,ILNP
	ADD	B,T
	ADD	E,LNWD(ARRY1)
	AOJL	A,COLP

	MOVE	THIS,XTAB
	PUSHJ	P,CORREL
	JRST	@RETAD

	PRGEND
	TITLE	COPPIC

	EXTERN	TEMP
        ENTRY	COPPIC

DEFINE RETAD <TEMP>

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
	BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

COPPIC:	POP	P,RETAD			;COPIES A PICTURE IN PIC1
	POP	P,ARRY2			;INTO PIC2 (THE LINE TABLE MUST
	POP	P,ARRY1			;BE ADJUSTED TO DO THIS)
	HRLZ	T,ARRY1			;  COPPIC(PIC1,PIC2)
	HRR	T,ARRY2
	MOVEI	TT,13(ARRY2)
	ADD	TT,PCLN(ARRY1)
	ADD	TT,LNBYA(ARRY1)
	ADD	TT,PCWD(ARRY1)
	BLT	T,(TT)
	MOVE	T,ARRY2
	SUB	T,ARRY1
	MOVN	TT,PCLN(ARRY1)
	SUBI	TT,1
	HRLZ	TT,TT
	HRRI	TT,BPTAB(ARRY2)
COPLP:	ADDM	T,(TT)
	AOBJN	TT,COPLP
	JRST	@RETAD

	PRGEND
	TITLE	WIXFAI

;FULLY FORMAT 2 ORIENTED PICTURE ROUTINES. EXTENSIONS TO THE CONVERTED
;FORMAT 1 ROUTINES IN WIXSUB
	
	ENTRY	HAFPIC,GETPAR,PUTPAR,PERBIT,HISTOG
        ENTRY	CMPPAR,CMPPAD,ROWSUM,ROWSUD,COLSUM
	ENTRY	UNPACK,NOISE,SUMSQR,LOWPAS,TILE

	EXTERN	CORGET,CORREL
	EXTERN	SQR,SQRL,TEMP

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
	BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

RETAD:	0
AR2TAB:	MOVEI	T,1
	LSH	T,@BYBI(ARRY2)		;BYTE MAXIMUM
	SUBI	T,1
	MOVEM	T,BMAX(ARRY2)
	MOVEI	T,44			;TOTAL BITS/WORD
	IDIV	T,BYBI(ARRY2)		;BYTE SIZE
	MOVEM	T,WDBY(ARRY2)		;BYTES PER WORD
	SUBI	TT,44			;-NUMBER OF USED BITS/WORD
	MOVNM	TT,WDBI(ARRY2)		;SAVED
	ADD	T,LNBY(ARRY2)
	SUBI	T,1
	IDIV	T,WDBY(ARRY2)		;NUMBER OF WORDS/SCANLINE
	MOVEM	T,LNWD(ARRY2)
	MOVE	TT,T	 		;WORDS/LINE
	IMUL	TT,WDBY(ARRY2)		;BYTES/WORD
	MOVEM	TT,LNBYA(ARRY2)		;GIVES BYTES/LINE, INCLUDING NULLS
	IMUL	TT,PCLN(ARRY2)
	MOVEM	TT,PCBYA(ARRY2)		;TOTAL BYTES/PIC, INCL. NULLS
	IMUL	T,PCLN(ARRY2)		;LINES IN THE PICTURE
	MOVEM	T,PCWD(ARRY2)		;WORDS IN THE PICTURE
	MOVE	T,LNBY(ARRY2)
	IMUL	T,PCLN(ARRY2)
	MOVEM	T,PCBY(ARRY2)		;BYTES/PIC, NOT INCL. NULLS
	MOVEI	T,15(ARRY2)
	ADD	T,PCLN(ARRY2)
	MOVEM	T,BPTAB(ARRY2)		;ADDRESS OF BYTE POINTER TABLE
	ADD	T,LNBYA(ARRY2)		;ADDR OF FIRST WORD IN PICTURE
	MOVN	TT,PCLN(ARRY2)		;SET UP CNTR FOR LINE ADDRESSES
	HRL	TT,TT
	HRRI	TT,LINTAB(ARRY2)
LTLP:	MOVEM	T,(TT)			;MAKE LINE TABLE
	ADD	T,LNWD(ARRY2)
	AOBJN	TT,LTLP
	MOVN	TT,BPTAB(ARRY2)
	HRL	TT,LNBYA(ARRY2)		;SET UP CNTR FOR BYTE TABLE
	AOBJN	TT,			;DECR ADDRESS AND INCR COUNT BY 1
	MOVN	TT,TT
	MOVEI	T,4400
	ADD	T,BYBI(ARRY2)
	LSH	T,6
	HRLZ	T,T
BYLP:	MOVEM	T,(TT)			;MAKE BYTE POINTER TABLE
	IBP	T
	AOBJN	TT,BYLP
	POPJ	P,
HAFPIC:	POP	P,RETAD
	POP	P,G	;MAXBIT
	POP	P,ARRY2			;MAKES A HALFSIZE VERSION
	POP	P,ARRY1			;OF A PICTURE
	MOVE	T,LNBY(ARRY1)		;HAFPIC(PICIN,PICOUT,BITMAX);
	ASH	T,-1			;NEW PIC IS HALF THE WIDTH
	MOVEM	T,LNBY(ARRY2)
	MOVE	T,PCLN(ARRY1)
	ASH	T,-1			;AND HALF THE HEIGHT
	MOVEM	T,PCLN(ARRY2)
	MOVE	T,BYBI(ARRY1)
	ADDI	T,2			;AND HAS TWO MORE BITS/PIXEL
	SUB	G,T			;UNLESS LIMITED TO LESS
        JUMPGE	G,.+2
        ADD	T,G
	MOVEM	T,BYBI(ARRY2)
	PUSHJ	P,AR2TAB		;SET UP ITS SKELETON
	MOVE	A,BPTAB(ARRY1)
	MOVE	A,-1(A)			;FIRST BYTE PNTR FOR ARRY1
	ADD	A,LINTAB(ARRY1)
	MOVE	B,BPTAB(ARRY2)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY2)
	MOVE	F,PCLN(ARRY2)		;NO OF LINES, FOR COUNT

		;IF NOT NEEDED TO REDUCE BITS/BYTE
	JUMPGE	G,[ LNLP: MOVE TTT,LNBY(ARRY2) ;NO OF BYTES, INNER LOOP CNTR
                          MOVE    C,A
                          ADD     A,LNWD(ARRY1)           ;BP S FOR ARRY1
                          MOVE    D,A
                          ADD     A,LNWD(ARRY1)
                          MOVE    E,B                     ;BP FOR ARRY2
                          ADD     B,LNWD(ARRY2)
                  CLLP:   ILDB    T,C                     ;FETCH FOUR BYTES AND ADD THEM
                          ILDB    TT,C
                          ADD     T,TT
                          ILDB    TT,D
                          ADD     T,TT
                          ILDB    TT,D
                          ADD     T,TT
                          IDPB    T,E                     ;THEN DEPOSIT SUM
                          SOJG    TTT,CLLP
                          SOJG    F,LNLP
                          JRST    @RETAD    ]

LNLP1:	MOVE	TTT,LNBY(ARRY2)		;NO OF BYTES, INNER LOOP CNTR
	MOVE	C,A
	ADD	A,LNWD(ARRY1)		;BP S FOR ARRY1
	MOVE	D,A
	ADD	A,LNWD(ARRY1)
	MOVE	E,B			;BP FOR ARRY2
	ADD	B,LNWD(ARRY2)
CLLP1:	ILDB	T,C			;FETCH FOUR BYTES AND ADD THEM
	ILDB	TT,C
	ADD	T,TT
	ILDB	TT,D
	ADD	T,TT
	ILDB	TT,D
	ADD	T,TT
	LSH	T,(G)			;TRUNCATE TO CORRECT # OF BITS
	IDPB	T,E			;THEN DEPOSIT SUM
	SOJG	TTT,CLLP1
	SOJG	F,LNLP1
	JRST	@RETAD
GETPAR:	POP	P,RETAD
	POP	P,ARRY2			;COPIES A FULL WORD ARRAY
	POP	P,ARRY1			;INTO A PICTURE

	MOVE	B,BPTAB(ARRY2)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY2)
	MOVE	F,PCLN(ARRY2)		;NO OF LINES, FOR COUNT

LNLPG:	MOVE	TTT,LNBY(ARRY2) ;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY2)
CLLPG:	MOVE    T,(ARRY1)               ;FETCH A WORD
	ADDI	ARRY1,1
	IDPB    T,E                     ;AND DEPOSIT A BYTE
	SOJG    TTT,CLLPG
	SOJG    F,LNLPG
	JRST    @RETAD
PUTPAR:	POP	P,RETAD
	POP	P,ARRY1			;COPIES A PICTURE
	POP	P,ARRY2			;INTO A FULL WORD ARRAY

	MOVE	B,BPTAB(ARRY2)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY2)
	MOVE	F,PCLN(ARRY2)		;NO OF LINES, FOR COUNT

LNPPP:	MOVE	TTT,LNBY(ARRY2) ;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY2)
CLPPP:  ILDB	T,E		        ;FETCH A WORD
	MOVEM   T,(ARRY1)               ;AND DEPOSIT A BYTE
	ADDI	ARRY1,1
	SOJG    TTT,CLPPP
	SOJG    F,LNPPP
	JRST    @RETAD
LOWPAS:	POP	P,RETAD
	POP	P,ARRY1	 ;picture	;average 4 for 1

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY1)
        MOVE	C,B
	IBP	C
        MOVE	D,B
	ADD	D,LNWD(ARRY1)
	MOVE	E,C
	ADD	E,LNWD(ARRY1)
	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT
        SUBI	F,1

LLNLPP:	MOVE	TTT,LNBYA(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
LCLLPP:	ILDB    T,B			;FETCH A SAMPLE
	ILDB	TT,C
	ADD	T,TT			;actually 4 of them
	ILDB	TT,D
	ADD	T,TT
	ILDB	TT,E
	ADDI	T,2(TT)
	ASH	T,-2
	DPB	T,B                     ;AND DEPOSIT IT
	SOJG    TTT,LCLLPP
	SOJG    F,LLNLPP
	JRST    @RETAD
PERBIT:	POP	P,RETAD
	POP	P,ARRY2  ;transform	;TRANSFORMS EACH SAMPLE OF A
	POP	P,ARRY1	 ;picture	;PICTURE ACCORDING TO A TABLE

	HRRM	ARRY2,ARF

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY1)
	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPP:	MOVE	TTT,LNBY(ARRY1) ;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
CLLPP:	ILDB    T,E			;FETCH A SAMPLE
ARF:	MOVE	T,(T)			;altered to <ARRY2>(T)
	DPB	T,E                     ;AND DEPOSIT IT
	SOJG    TTT,CLLPP
	SOJG    F,LNLPP
	JRST    @RETAD
HISTOG:	POP	P,RETAD
	POP	P,ARRY2  ;HISTOGRAM	;MAKES A HISTOGRAM OF THE
	POP	P,ARRY1	 ;picture	;GREY LEVELS IN A PICTURE

	HRRM	ARRY2,ARFG
	HRRM	ARRY2,ARFH

	MOVEI	A,1
	LSH	A,@BYBI(ARRY1)
	SUBI	A,1
ARFH:	SETZM	(A)			;CLEAR THE ARRAY
	SOJGE	A,ARFH


	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY1)
	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPH:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
CLLPH:	ILDB    T,E			;FETCH A SAMPLE
ARFG:	AOS	(T)			;altered to <ARRY2>(T)
	SOJG    TTT,CLLPH
	SOJG    F,LNLPH
	JRST    @RETAD
COLSUM:	POP	P,RETAD
	POP	P,ARRY2  ;COL SUMS	;calculates the sum of each col of a pict
	POP	P,ARRY1	 ;picture

	MOVN	TTT,LNBY(ARRY1)
	HRL	ARRY2,TTT

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;FIRST BP FOR ARRY1
	ADD	B,LINTAB(ARRY1)

	MOVE	TTT,ARRY2
CCCL:	SETZM	(TTT)			;CLEAR COL SUM ARRY
	AOBJN	TTT,CCCL

	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPSC:	MOVE	TTT,ARRY2	 	;NO OF BYTES, INNER LOOP CNTR

	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)

CLLPSC:	ILDB    T,E			;FETCH A SAMPLE
	ADDM	T,(TTT)			;ADD IT TO SUM ENTRY
	AOBJN   TTT,CLLPSC

	SOJG    F,LNLPSC

	JRST    @RETAD
ROWSUM:	POP	P,RETAD
	POP	P,ARRY2  ;ROW SUMS	;calculates the sum of each row of a pict
	POP	P,ARRY1	 ;picture

	HRRM	ARRY2,ARFS

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY1)

	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPS:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
	SETZM	@ARFS
CLLPS:	ILDB    T,E			;FETCH A SAMPLE
ARFS:	ADDM	T,0			;altered to <ARRY2>(TTT)
	SOJG    TTT,CLLPS
	AOS	ARFS
	SOJG    F,LNLPS
	JRST    @RETAD

SUMSQR:	POP	P,RETAD		;sum of squares of pixels, double precision real
	POP	P,ARRY1	       ;picture
				;  V←SUMSQR(PIC[0]);
	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR ARRY2
	ADD	B,LINTAB(ARRY1)

	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

	SETZB	C,D			;SUM WILL ACCUMULATE HERE
	SETZB	T,TT

LNLPSQ:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY1
	ADD     B,LNWD(ARRY1)
	SETZ	@ARFS
CLLPSQ:	ILDB    T,E			;FETCH A SAMPLE
	FLTR	T,T			;FLOAT IT (SECOND HALF IS 0 WORD)
	DFMP	T,T			;SQUARE IT
       	DFAD	C,T			;ADD TO SUM
	SOJG    TTT,CLLPSQ
	SOJG    F,LNLPSQ

	MOVE	1,C			;RETURN RESULT
	MOVE	2,D

	JRST    @RETAD
NOISE:	POP	P,RETAD  ;calculates sum(x[i+1,j]-x[i,j])↑2/sum(x-xbar)↑2
	POP	P,ARRY1	 ;noise←NOISE(PICTURE)

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;FIRST BP FOR ARRY1
	ADD	B,LINTAB(ARRY1)
        
	MOVE	F,PCLN(ARRY1)
	SUBI	F,1
SX←←A
SXX←←D
SDX←←TT

	SETZB	SX,SXX
	SETZ	SDX,

LNLNO:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
	MOVE	C,B
CLLNO:	ILDB    T,E			;FETCH A SAMPLE
        FLTR	T,T
	ILDB	G,C
	FLTR	G,G
	FSBR	G,T
	FMPR	G,G
	FADR	SDX,G
	FADR	SX,T
	FMPR	T,T
	FADR	SXX,T
	SOJG    TTT,CLLNO
	SOJG    F,LNLNO
	
	MOVE	T,PCLN(ARRY1)
	SUBI	T,1
	IMUL	T,LNBY(ARRY1)
	FLTR	T,T
	FMPR	SX,SX
	FDVR	SX,T
	FSBR	SXX,SX
 	FDVR	SDX,SXX
	MOVE	1,SDX

	JRST    @RETAD
UNPACK:	POP	P,RETAD	; UNPACK A DENSE BYTE ARRAY INTO A PICTURE
	POP	P,ARRY1  ;destination picture
	POP	P,ARRY2	 ;original packed array

	MOVE 	C,BPTAB(ARRY1)
	ADD	ARRY2,-1(C)		;construct byte pntr for source array

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;AND FIRST BP FOR destination
	ADD	B,LINTAB(ARRY1)

	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPU:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
CLLPU:	ILDB	T,ARRY2
	IDPB    T,E			;MOVE A SAMPLE
	SOJG    TTT,CLLPU
	SOJG    F,LNLPU
	JRST    @RETAD
; TILE(PIC1,YL1,XL1, TY,TX, PIC2,YL2,XL2);
; copy a TY by TX window from PIC1 with upleft corner YL1,XL1 into
; a TY by TX window in PIC2 with upleft at YL2,XL2

PIC1←←1 ↔ XL1←←2 ↔ YL1←←3    ;source picture, upper left corner of copied piece
PIC2←←4 ↔ XL2←←5 ↔ YL2←←6    ;dest picture, upper left corner of destination
TY←←7 ↔ TX←←10               ;window size, height, width
BYSH←←11		     ;how much to shift bytes
TXX←←13			     ;temporary - inner loop counter


TILE:  	POP	P,RETAD	 ;copy a piece of one picture into a piece of another
	POP	P,XL2
	POP	P,YL2
	POP	P,PIC2   ;destination picture
	POP	P,TX
	POP	P,TY
	POP	P,XL1
	POP	P,YL1
	POP	P,PIC1	 ;source picture

	;  bounds check on window upleft edge
	JUMPL	XL1,[ADD TX,XL1 ↔ SUB XL2,XL1 ↔ SUB XL1,XL1 ↔ JRST .+1]
	JUMPL	YL1,[ADD TY,YL1 ↔ SUB YL2,YL1 ↔ SUB YL1,YL1 ↔ JRST .+1]
	JUMPL	XL2,[ADD TX,XL2 ↔ SUB XL1,XL2 ↔ SUB XL2,XL2 ↔ JRST .+1]
	JUMPL	YL2,[ADD TY,YL2 ↔ SUB YL1,YL2 ↔ SUB YL2,YL2 ↔ JRST .+1]

        MOVE	0,LNBY(PIC1)	;bounds check on window width
	SUB	0,XL1
	CAMLE	TX,0
        MOVE	TX,0
        MOVE	0,LNBY(PIC2)
	SUB	0,XL2
	CAMLE	TX,0
        MOVE	TX,0
	JUMPLE	TX,@RETAD

        MOVE	0,PCLN(PIC1)	;bounds check on height
	SUB	0,YL1
	CAMLE	TY,0
        MOVE	TY,0
        MOVE	0,PCLN(PIC2)
	SUB	0,YL2
	CAMLE	TY,0
        MOVE	TY,0
	JUMPLE	TY,@RETAD

	ADD	XL1,BPTAB(PIC1)		;SYNTHESIZE BYTE POINTER
	MOVE	XL1,-1(XL1)		;FOR SOURCE ARRAY
	ADDI	YL1,LINTAB(PIC1)
	ADD	XL1,(YL1)

	ADD	XL2,BPTAB(PIC2)
	MOVE	XL2,-1(XL2)		;AND FIRST BP FOR destination
	ADDI	YL2,LINTAB(PIC2)
	ADD	XL2,(YL2)

	MOVE	BYSH,BYBI(PIC2)		;SHIFT AMOUNT, FOR NON EQUAL BYTE SIZES
	SUB	BYSH,BYBI(PIC1)

LNLPT:	MOVE	TXX,TX			;NO OF BYTES, INNER LOOP CNTR
	MOVE    YL2,XL2                   ;BP FOR PIC2
	ADD     XL2,LNWD(PIC2)
	MOVE	YL1,XL1			  ;BP FOR PIC1
	ADD	XL1,LNWD(PIC1)
CLLPT:	ILDB	0,YL1
        LSH	0,(BYSH)
	IDPB    0,YL2			;MOVE A SAMPLE
	SOJG    TXX,CLLPT
	SOJG    TY,LNLPT

	JRST    @RETAD
ROWSUD:	POP	P,RETAD			;much quicker and dirtier than ROWSUM
	POP	P,ARRY2  ;ROW SUMS	;roughly calculates row sums
	POP	P,ARRY1	 ;picture

	SUBI	ARRY2,1

	MOVN	B,LNWD(ARRY1)

	MOVE	TTT,LINTAB(ARRY1)
	MOVE	F,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPD:	HRL	TTT,B		 	;NO OF WORDS, INNER LOOP CNTR
	MOVEI	TT,0
CLLPD:	HLRZ    T,(TTT)			;FETCH A SAMPLE, SORT OF
	ADD	TT,T
	AOBJN   TTT,CLLPD
	PUSH	ARRY2,TT
	SOJG    F,LNLPD
	JRST    @RETAD
DEFINE SHFT1 <TEMP+1>

CMPPAR:	POP	P,RETAD
	POP	P,ARRY2  ;picture y	;compares two pictures
	POP	P,ARRY1	 ;picture x	;sigma(xi-yi)↑2/n

	MOVE	B,BPTAB(ARRY1)
	MOVE	B,-1(B)			;FIRST BP FOR ARRY1
	ADD	B,LINTAB(ARRY1)

	MOVE	C,BPTAB(ARRY2)
	MOVE	C,-1(C)			;AND FIRST BP FOR ARRY2
	ADD	C,LINTAB(ARRY2)

	MOVEI	T,7			;CALCULATE NORMALIZATION SHIFT
	SUB	T,BYBI(ARRY1)		;FOR MAKING SAMPLES 7 BITS
	HRRZM	T,SHFT1			;USING FIRST PICTURE

	MOVEI	A,0			;INITIALIZE SUM

	MOVE	G,PCLN(ARRY1)		;NO OF LINES, FOR COUNT

LNLPC:	MOVE	TTT,LNBY(ARRY1) 	;NO OF BYTES, INNER LOOP CNTR
	MOVE    E,B                     ;BP FOR ARRY2
	ADD     B,LNWD(ARRY1)
	MOVE	F,C
	ADD	C,LNWD(ARRY2)
CLLPC:	ILDB    T,E			;FETCH A SAMPLE
	ILDB	TT,F
	SUB	T,TT
	ASH	T,@SHFT1
	ADD	A,SQR(T)		;and add (xi-yi)↑2 to A
	SOJG    TTT,CLLPC
	SOJG    G,LNLPC

	FLTR	A,A
	MOVE	B,PCBY(ARRY1)
	FLTR	B,B
	FDVR	A,B
	MOVE	1,A

	JRST    @RETAD
CMPPAD:	POP	P,RETAD
	POP	P,ARRY2  ;picture y	;compares two pictures, quick and dirty
	POP	P,ARRY1	 ;picture x	;sigma abs(xi-yi) for some xi,yi


	MOVE	G,PCWD(ARRY1)		;NO OF WORDS, FOR COUNT
	MOVE	E,LINTAB(ARRY1)		;address of first word or arry1
	SUBI	E,1
	HRRM	E,PAD
	MOVE	F,LINTAB(ARRY2)		;address of first word or arry2
	SUBI	F,1
	HRRM	F,PAD+1

	SETZ 	T,
PAD:	HLRZ    A,(G)			;FETCH A SAMPLE
	HLRZ	B,(G)
	SUB     A,B
	MOVM	A,A
	ADD	T,A
	SOJG    G,PAD

	MOVE	1,T

	JRST    @RETAD

	PRGEND
	TITLE	CENTRO

;FIND THE CENTRIOD OF BLACK AREA IN A PICTURE WINDOW
	
	ENTRY	CENTRO

	EXTERN	SQR,SQRL,TEMP

	OPDEF	FIX[247000233000]

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
        BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	TTT←1  ↔  TT←2  ↔  T←3  ↔  ARRY1←4  ↔  TRES←5  ↔  P←17
	X2←6 ↔  X1←7  ↔  Y2←10  ↔  Y1←11  ↔  E←13  ↔  F←14  ↔  G←15


DEFINE	RETAD	<TEMP>
DEFINE	X2A	<TEMP+2>
DEFINE	Y2A	<TEMP+3>
DEFINE	X1A	<TEMP+4>
DEFINE	Y1A	<TEMP+5>

CENTRO:	POP	P,RETAD	 ;find centroid of black area in a window

	POP	P,TRES	  ;threshold
	POP	P,X2A	  ;   #BLACK ← CENTRO(PIC,Y1,X1,Y2,X2,THRESH)
	POP	P,Y2A	  ;	CENTROID POSITION RETURNED
	POP	P,X1A	  ;        Y1, X1
	POP	P,Y1A
	POP	P,ARRY1	 ;source picture

	MOVE	X1,@X1A
	FIX	X1,
	MOVE	Y1,@Y1A
	FIX	Y1,
	MOVE	X2,@X2A
	FIX	X2,
	MOVE	Y2,@Y2A
	FIX	Y2,

	SETZM	@X2A
	SETZM	@Y2A

	SETZ	TTT,

	CAMLE	X1,X2			;FIX UP LIMITS
	EXCH	X1,X2
	CAMLE	Y1,Y2
	EXCH	Y1,Y2
	CAIL	X2,0
	CAML	X1,LNBY(ARRY1)
	JRST	GUPP
	CAIL	Y2,0
	CAML	Y1,PCLN(ARRY1)
	JRST	GUPP
	CAIGE	X1,0
	MOVEI	X1,0
	MOVE	T,LNBY(ARRY1)
	CAML	X2,T
	MOVEI	X2,-1(T)
	CAIGE	Y1,0
	MOVEI	Y1,0
	MOVE	T,PCLN(ARRY1)
	CAML	Y2,T
	MOVEI	Y2,-1(T)
	
	SUBM	Y1,Y2			;NO OF LINES, FOR COUNT
	SUBI	Y2,1
	HRL	Y1,Y2

	SUBM	X1,X2			;NO OF COLUMNS
	SUBI	X2,1
	HRL	X1,X2

	MOVE    E,BPTAB(ARRY1)          ;GENERATE INITIAL BYTE PNTR
	ADDI	E,-1(X1)
	MOVE	E,(E)
	HRRZ	T,Y1
	ADD	T,ARRY1
	ADD     E,LINTAB(T)

	SETZB	X2,Y2			;SUM OF POSITION REGS
	SETZ	TT,			;HIT COUNT

LNLPCE:	MOVE	F,E		 	;NO OF BYTES, INNER LOOP CNTR
	MOVE	G,X1

CLLPCE:	ILDB	T,F

        CAMLE	T,TRES       ;REGISTER A BLACK SAMPLE, if below threshold
	JRST	NOTBL
	MOVEI	T,(G)        ;this is integer (= true value -.5) x position
	IMUL	T,T	     ; ix↑2
	ADDM	T,@X2A       ; in X2A
	MOVEI	T,(Y1)	     ; iy
	IMUL	T,T	     ; iy↑2
	ADDM	T,@Y2A       ; to Y2A
	ADDI    X2,(G)	     ; sig x in x2
	ADDI	Y2,(Y1)	     ; sig y in y2
	ADDI	TT,1	     ; sig 1 in tt
NOTBL:	AOBJN   G,CLLPCE
        
	ADD	E,LNWD(ARRY1)

	AOBJN   Y1,LNLPCE

	JUMPE	TT,GUPP

	FLTR	TT,TT
	FLTR	Y2,Y2
	FLTR	X2,X2

	FDVR	Y2,TT
	FADR	Y2,[0.5]
	MOVEM	Y2,@Y1A

	FDVR	X2,TT	     ; X2/TT is avg(x-.5) = avg(x) - .5
        FADR	X2,[0.5]
	MOVEM	X2,@X1A

	FLTR	TTT,@X2A     ; X2A/TT is avg((x-.5)↑2) = avg(x↑2) - avg(x) +.25
	FDVR	TTT,TT
	FADR	TTT,X2
	FSBR	TTT,[0.25]
	FMPR	X2,X2	    ; avg(x - avg(x))↑2 = avg(x↑2)-avg(x)↑2
	FSBR	TTT,X2
	MOVEM	TTT,@X2A

	FLTR	TTT,@Y2A
	FDVR	TTT,TT
	FADR	TTT,Y2
	FSBR	TTT,[0.25]
	FMPR	Y2,Y2
	FSBR	TTT,Y2
	MOVEM	TTT,@Y2A

	MOVE	TTT,TT
	FIX	TTT,

GUPP:	JRST    @RETAD

	PRGEND
	TITLE	INTOP

	EXTERN	TEMP,SQR,SQRL,CORGET,CORREL
	ENTRY	INTOP,INTLOM
SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←←13
LINTAB←←14
%

VW←0
POS←1
CNT1←2  ↔  THIS←2
CNT2←3  ↔  SIZ←3
ARRY←4
ARRYO←5
PNT←6
CNT←7
D1C←10
D2C←11
T←13
HC←14
VC←15
	P←17

DEFINE	RETAD <TEMP>
DEFINE	VERWIN <TEMP+1>
DEFINE	HORWIN <TEMP+2>
DEFINE	STRP <TEMP+3>
DEFINE	WIND <TEMP+4>
DEFINE	TOP <TEMP+5>
DEFINE	SUM <TEMP+6>
DEFINE	NWIN <TEMP+7>
DEFINE	XIN <TEMP+10>
DEFINE	YIN <TEMP+11>

INTOP:	POP	P,RETAD		; INTOP(PIC,WINDOWSIZE,RESULTARRAY)
	POP	P,XIN
	POP	P,YIN
	POP	P,ARRYO		;  INTEREST OPERATOR, NO LOCAL
	POP	P,WIND		;  MAXIMUM TEST
	POP	P,ARRY

	MOVE	1,LNBY(ARRY)
	SUBI	1,1
	SUB	1,XIN
	IDIV	1,WIND
	MOVEM	1,HORWIN
	MOVE	1,PCLN(ARRY)
	SUB	1,YIN
	SUBI	1,1
	IDIV	1,WIND
	MOVEM	1,VERWIN
	IMUL	1,HORWIN
	MOVEM	1,NWIN

	MOVE	PNT,BPTAB(ARRY)
	MOVE	PNT,-1(PNT)
	MOVE	T,ARRY
	ADD	T,YIN
	ADD	PNT,LINTAB(T)

	MOVE	SIZ,WIND
	ADDI	SIZ,1
	IMUL	SIZ,LNBYA(ARRY)
	MOVN	T,SIZ
	HRLZM	T,STRP
	PUSHJ	17,CORGET
	HALT

	HRRM	THIS,PQ1
	HRRM	THIS,ILP
	HRRM	THIS,PQ2
	HRRM	THIS,PQ3
	ADDI	THIS,1
	HRRM	THIS,PR1
	HRRM	THIS,PR2
	ADD	THIS,LNBYA(ARRY)
	HRRM	THIS,PP1
	SUBI	THIS,1
	HRRM	THIS,PP
	HRRM	THIS,PP0

	MOVEI	T,5		;CALCULATE SHIFT NEEDED TO MAKE SAMPLE SIZE
	SUB	T,BYBI(ARRY)	;FIVE BITS
	HRRM	T,SHFT1

	SUBI	ARRYO,1
	MOVE	VW,VERWIN
	SETZM	SUM
VERLP:	MOVE	CNT,STRP
UNPAK:	ILDB	T,PNT
SHFT1:	LSH	T,0
PQ1:	MOVEM	T,(CNT)
	AOBJN	CNT,UNPAK

	MOVE	CNT,HORWIN
	MOVE	POS,XIN
	MOVEM	POS,TOP
KLP:	SETZB	HC,VC
	SETZB	D1C,D2C
	MOVE	CNT2,WIND
JLP:	MOVE	CNT1,WIND
ILP:	MOVE	T,(POS)
PR1:	SUB	T,(POS)
	ADD	HC,SQR(T)
PQ2:	MOVE	T,(POS)
PP:	SUB	T,(POS)			;REPLACED BY STRIP+<PICWID>(POS)
	ADD	VC,SQR(T)
PQ3:	MOVE	T,(POS)
PP1:	SUB	T,(POS)			;REPLACED BY STRIP +<PICWID>+1
	ADD	D1C,SQR(T)
PR2:	MOVE	T,(POS)
PP0:	SUB	T,(POS)			;REPLACED BY STRIP+<PICWID>-1
	ADD	D2C,SQR(T)
	ADD	POS,LNBYA(ARRY)
	SOJG	CNT1,ILP
	AOS	POS,TOP
	SOJG	CNT2,JLP

	CAMLE	HC,VC
	MOVE	HC,VC
	CAMLE	HC,D1C
	MOVE	HC,D1C
	CAMLE	HC,D2C
	MOVE	HC,D2C
	LSH	HC,1

	ORI	HC,1
	ADDM	HC,SUM
	PUSH	ARRYO,HC
	SOJG	CNT,KLP
	SUB	PNT,LNWD(ARRY)
	SOJG	VW,VERLP

	HRRZ	THIS,PQ1
	PUSHJ	17,CORREL

	MOVE	1,SUM
	IDIV	1,NWIN
	JRST	@RETAD
;	INTLOM(VER,HOR,ARRY)		;INTEREST OPERATOR LOCAL MXIMUM TEST

VER←1 ↔  HOR←2  ↔  CNT←3  ↔   T←4  ↔   PEL←5



INTLOM:	POP	P,RETAD		;INTEREST OPERATOR LOCAL MAXIMUM TEST
	POP	P,CNT
	POP	P,HOR
	POP	P,VER
	MOVEI	T,-2(VER)	;CALCULATE NUMBER OF WORDS THAT CAN BE DONE
	IMUL	T,HOR
	SUBI	T,2
	MOVN	T,T
	HRL	CNT,T

	MOVE	T,HOR		;FIXUP THE OFFSET ARRAY REFERENCES
	HRRM	T,A10
	HRRM	T,A10+2
	HRRM	T,B10
	HRRM	T,B10+1
	HRRM	T,C10
	HRRM	T,C10+2
	HRRM	T,D10
	HRRM	T,D10+1
	HRRM	T,E10
	HRRM	T,E10+2
	HRRM	T,F10
	HRRM	T,F10+1

	MOVE	T,HOR
	LSH	T,1
	HRRM	T,A20
	HRRM	T,A20+2
	HRRM	T,B20
	HRRM	T,B20+1
	HRRM	T,C20
	HRRM	T,C20+2
	HRRM	T,D20
	HRRM	T,D20+1
	HRRM	T,E20
	HRRM	T,E20+2
	HRRM	T,F20
	HRRM	T,F20+1

	MOVE	T,HOR
	ADDI	T,1
	HRRM	T,A11
	HRRM	T,A11+2
	HRRM	T,B11
	HRRM	T,B11+1

	MOVE	T,HOR
	ADDI	T,2
	HRRM	T,A12
	HRRM	T,A12+2
	HRRM	T,B12
	HRRM	T,B12+1

	MOVE	T,HOR
	LSH	T,1
	ADDI	T,1
	HRRM	T,A21
	HRRM	T,A21+2
	HRRM	T,B21
	HRRM	T,B21+1

	MOVE	T,HOR
	LSH	T,1
	ADDI	T,2
	HRRM	T,A22
	HRRM	T,A22+2
	HRRM	T,B22
	HRRM	T,B22+1

	MOVEI	T,1

GOLL:	MOVE	PEL,(CNT)	;BEGIN THE LOOP

	TRNN	PEL,1		;COMPARISONS INVOLVING UPPER LEFT ELEMENT
	JRST	B01
A01:	CAMGE	PEL,1(CNT)
	SOJA	PEL,B02
	ANDCAM	T,1(CNT)
A02:	CAMGE	PEL,2(CNT)
	SOJA	PEL,B10
	ANDCAM	T,2(CNT)
A10:	CAMGE	PEL,(CNT)
	SOJA	PEL,B20
	ANDCAM	T,(CNT)
A20:	CAMGE	PEL,(CNT)
	SOJA	PEL,B11
	ANDCAM	T,(CNT)
A11:	CAMGE	PEL,1(CNT)
	SOJA	PEL,B12
	ANDCAM	T,1(CNT)
A12:	CAMGE	PEL,1(CNT)
	SOJA	PEL,B21
	ANDCAM	T,1(CNT)
A21:	CAMGE	PEL,1(CNT)
	SOJA	PEL,B22
	ANDCAM	T,1(CNT)
A22:	CAMGE	PEL,1(CNT)
	SOJA	PEL,LDN
	ANDCAM	T,1(CNT)
	JRST	LDN

B01:	CAMLE	PEL,1(CNT)
	ANDCAM	T,1(CNT)
B02:	CAMLE	PEL,2(CNT)
	ANDCAM	T,2(CNT)
B10:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)
B20:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)
B11:	CAMLE	PEL,1(CNT)
	ANDCAM	T,1(CNT)
B12:	CAMLE	PEL,2(CNT)
	ANDCAM	T,2(CNT)
B21:	CAMLE	PEL,1(CNT)
	ANDCAM	T,1(CNT)
B22:	CAMLE	PEL,2(CNT)
	ANDCAM	T,2(CNT)

LDN:	MOVEM	PEL,(CNT)

	MOVE	PEL,1(CNT)		;UPPER SECOND ELEMENT
	TRNN	PEL,1
	JRST	D10
C10:	CAMGE	PEL,(CNT)
	SOJA	PEL,D20
	ANDCAM	T,(CNT)
C20:	CAMGE	PEL,(CNT)
	SOJA	PEL,MDN
	ANDCAM	T,(CNT)
	JRST	MDN

D10:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)
D20:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)

MDN:	MOVEM	PEL,1(CNT)

	MOVE	PEL,2(CNT)		;UPPER RIGHT ELEMENT
	TRNN	PEL,1
	JRST	F10
E10:	CAMGE	PEL,(CNT)
	SOJA	PEL,F20
	ANDCAM	T,(CNT)
E20:	CAMGE	PEL,(CNT)
	SOJA	PEL,ODN
	ANDCAM	T,(CNT)
	JRST	ODN

F10:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)
F20:	CAMLE	PEL,(CNT)
	ANDCAM	T,(CNT)

ODN:	MOVEM	PEL,2(CNT)

	AOBJN	CNT,GOLL

	JRST	@RETAD

	PRGEND
	TITLE	MATCH
	ENTRY	MATCH
	EXTERN	SQR,SQRL,CORGET,CORREL
	EXTERN	TEMP

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
	BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

X1←←A ↔ Y1←←B ↔ X2←←C ↔ Y2←←D
DEFINE AX1 <TEMP>
DEFINE AY1 <TEMP+1>
DEFINE AX2 <TEMP+2>
DEFINE AY2 <TEMP+3>
DEFINE BX1 <TEMP+4>
DEFINE BY1 <TEMP+5>
DEFINE BX2 <TEMP+6>
DEFINE BY2 <TEMP+7>
DEFINE SOUWIN <TEMP+10>
DEFINE DESWIN <TEMP+11>
DEFINE DEXSKP <TEMP+12>
DEFINE DEYSKP <TEMP+13>
DEFINE WSIZ1 <TEMP+14>
DEFINE DWSIZ <TEMP+15>
DEFINE WSIZY1 <TEMP+16>
DEFINE VARIAN <TEMP+17>
DEFINE SOUSIZ <TEMP+20>
DEFINE WSIZ <TEMP+21>
DEFINE DWSIZ <TEMP+22>
DEFINE SHFT1 <TEMP+23>
DEFINE SHFT2 <TEMP+24>
DEFINE RETAD <TEMP+25>

MATCH:	POP	P,RETAD
	POP	P,BX2		;A CORRELATOR. FINDS THE BEST MATCH
	POP	P,BY2		;TO RECTANGLE ARRY1(AX1:AX2,AY1:AY2)
	POP	P,BX1		;IN ARRY2(BX1:BY1,BX2:BY2)
	POP	P,BY1		;ALL ARGUMENT ARE BY REFERENCE. THE
	POP	P,ARRY2		;A'S AND B'S MAY BE ADJUSTED TO MAKE
	MOVE	X1,@BX1		;THINGS FIT
	MOVE	X2,@BX2		;   MATCH(PIC1,AX1,AY1,AX2,AY2,
	MOVE	Y1,@BY1		;         PIC2,BX1,BY1,BX2,BY2);
	MOVE	Y2,@BY2

FIXB:	CAMLE	X1,X2		;FIRST FIX UP THE LIMITS SO
	EXCH	X1,X2		;X1≤X2, X1≥0 X2<WIDTH ETC.
	CAIGE	X1,0
	MOVEI	X1,0
	MOVE	T,LNBY(ARRY2)
	CAML	X2,T
	MOVEI	X2,-1(T)

	CAMLE	Y1,Y2		;SIMILAR FOR Y
	EXCH	Y1,Y2
	CAIGE	Y1,0
	MOVEI	Y1,0
	MOVE	T,PCLN(ARRY2)
	CAML	Y2,T
	MOVEI	Y2,-1(T)

	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	FIXB

	MOVEM	X1,@BX1
	MOVEM	X2,@BX2
	MOVEM	Y1,@BY1
	MOVEM	Y2,@BY2

	POP	P,AX2		;DO SAME FOR SOURCE WINDOW
	POP	P,AY2
	POP	P,AX1
	POP	P,AY1
	POP	P,ARRY1
	MOVE	X1,@AX1
	MOVE	X2,@AX2
	MOVE	Y1,@AY1
	MOVE	Y2,@AY2

	MOVEI	T,5		;CALCULATE SHIFTS NEEDED TO
	SUB	T,BYBI(ARRY1)	;CHANGE BOTH WINDOWS TO
	HRRZM	T,SHFT1		;FIVE BITS/SAMPLE (TO FIT THE SQUARES
	MOVEI	T,5		;TABLE)
	SUB	T,BYBI(ARRY2)
	HRRZM	T,SHFT2

FIXA:	CAMLE	X1,X2		;FIRST FIX UP THE LIMITS SO
	EXCH	X1,X2		;X1≤X2, X1≥0 X2<WIDTH ETC.
	CAIGE	X1,0
	MOVEI	X1,0
	MOVE	T,LNBY(ARRY1)
	CAML	X2,T
	MOVEI	X2,-1(T)

	CAMLE	Y1,Y2		;SIMILAR FOR Y
	EXCH	Y1,Y2
	CAIGE	Y1,0
	MOVEI	Y1,0
	MOVE	T,PCLN(ARRY1)
	CAML	Y2,T
	MOVEI	Y2,-1(T)

	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	FIXA

	MOVE	T,@BX1		;SHRINK SOURCE WINDOW SYMMETRICALLY
	SUB	T,@BX2		;UNTIL IT IS NO
	ADD	T,X2		;LARGER THAN DESTINATION WINDOW
	SUB	T,X1	
	JUMPLE	T,YSHRNK
	MOVEI	TT,1(T)
	ASHC	T,-1
	ADDI	X1,(T)
	SUBI	X2,(TT)

YSHRNK:	MOVE	T,@BY1		;SHRINK IN Y DIRECTION
	SUB	T,@BY2		;UNTIL IT IS NO
	ADD	T,Y2		;LARGER THAN DESTINATION WINDOW
	SUB	T,Y1	
	JUMPLE	T,RESTA
	MOVEI	TT,1(T)
	ASHC	T,-1
	ADDI	Y1,(T)
	SUBI	Y2,(TT)

RESTA:	MOVEM	X1,@AX1
	MOVEM	Y1,@AY1
	MOVEM	X2,@AX2
	MOVEM	Y2,@AY2

THIS←←TT ↔ SIZ←←TTT

	MOVEI	SIZ,1(X2)	;CALCULATE SIZE OF BUFFER AREA
	SUB	SIZ,X1		;FOR THE SOURCE WINDOW CODE
	MOVEM	SIZ,WSIZ1	;WILL BE X WINDOWSIZE-1
	MOVEM	SIZ,WSIZ	;IS X WINDOWSIZ
	MOVNM	SIZ,DEXSKP	;WILL BE DELTA XB - DELTA XA
	MOVEI	T,1(Y2)
	SUB	T,Y1
	MOVEM	T,WSIZY1	;WILL BE X WINDOWSIZE-1
	MOVNM	T,DEYSKP	;WIL BE DELTA YB - DELTA YA
	IMUL	SIZ,T
	MOVEM	SIZ,SOUSIZ	;SOURCE WINDOW SIZE (IN PIXELS)
	ASH	SIZ,1
	ADDI	SIZ,1
	PUSHJ	P,CORGET	;AND MAKE THAT BUFFER
	HALT
	MOVEM	THIS,SOUWIN

	SUBI	THIS,1
	MOVN	T,T
	HRLZ	T,T
	HRRI	T,LINTAB(ARRY1)	;Y COUNTER
	ADD	T,Y1

	MOVE	0,@BX2		;FINISH UP MAKING DELTA XB -DELTA XA
	SUB	0,@BX1
	ADDI	0,1
	MOVEM	0,DWSIZ
	ADDM	0,DEXSKP
	MOVE	0,@BY2		;AND THE Y'S TOO
	SUB	0,@BY1
	ADDI	0,1
	ADDM	0,DEYSKP
	SOS	WSIZ1		;NOT TO MENTION X WINDOWSIZ-1
	SOS	WSIZY1		;AND Y WINDOWSIZ-1

	MOVE	G,[MOVN TT,0(T)]

	MOVE	E,BPTAB(ARRY1)	;BP SKELETON
	ADDI	E,-1(X1)
	MOVE	E,(E)

	SETZB	B,A			;FOR SUM OF X AND X↑2, AS EXPLND BELOW
			;DON'T FORGET! A,B,C,D ARE X1,X2,Y1,Y2 ALSO
ILYLP:	MOVE	F,E			;SETS UP IN LINE CODED
	ADD	F,(T)			;STUFF FOR THE INNER
	MOVE	TTT,WSIZ		;"LOOP" OF THE CORRELATION
ILXLP:	PUSH	THIS,G			;A SEQUENCE OF
	ADDI	G,1			; MOVN TT,POSB(T)
	ILDB	C,F			; ADD  A,SQR+PIXEL(TT)
	LSH	C,@SHFT1
	ADD	B,C
	ADD	A,SQR(C)
	ADD	C,[ADD	A,SQR(TT)]
	PUSH	THIS,C
	SOJG	TTT,ILXLP
	ADD	G,DEXSKP
	AOBJN	T,ILYLP

	PUSH	THIS,[JRST INRDON]	;AND THE FINAL INSTR.
	
;CALCULATE SUM[(X-XBAR)↑2] ALSO. THIS IS SAME AS SUM[X↑2-2 X XBAR+XBAR↑2],
;WHICH IS SUM[X↑2]-2 XBAR SUM[X]+XBAR↑2*N OR, SINCE XBAR=SUM[X]/N,
;SUM[X↑2]-2(SUM[X])↑2/N+(SUM[X])↑2/N WHICH IS SUM[X↑2]-(SUM[X])↑2/N
; THIS QUANTITY WILL BE CALLED VARIANCE

	IMUL	B,B
	IDIV	B,SOUSIZ
	SUB	A,B
	MOVEM	A,VARIAN

	MOVE	X1,@BX1			;MAKE THE DESTINATION
	MOVE	X2,@BX2			;WINDOW BUFFER
	MOVE	Y1,@BY1
	MOVE	Y2,@BY2
	MOVEI	SIZ,1(X2)
	SUB	SIZ,X1
	MOVEM	SIZ,DWSIZ
	MOVEI	T,1(Y2)
	SUB	T,Y1
	IMUL	SIZ,T
	PUSHJ	P,CORGET
	HALT
	MOVEM	THIS,DESWIN

	SUBI	THIS,1
	MOVN	T,T			;Y COUNTER
	HRLZ	T,T
	HRRI	T,LINTAB(ARRY2)
	ADD	T,Y1

	MOVE	E,BPTAB(ARRY2)		;BYTE POINTER SKELETON
	ADDI	E,-1(X1)		;FOR DESTINATION
	MOVE	E,(E)

BUYLP:	MOVE	F,E			;UNPACKS THE DESTINATION
	ADD	F,(T)			;WINDOW, ONE WORD/SAMPLE
	MOVE	TTT,DWSIZ
BUXLP:	ILDB	0,F
	LSH	0,@SHFT2
	PUSH	THIS,0
	SOJG	TTT,BUXLP
	AOBJN	T,BUYLP

	MOVN	B,DEXSKP		;NOW ACTUALLY CORRELATE
	SUBI	B,1

	HRLZI	D,377777		;VALUE OF BEST MATCH IN D
	MOVE	E,DESWIN		;LOCATION IN E
	MOVE	C,DEYSKP		;NUMBER OF ROWS
	MOVE	T,DESWIN		;WHERE TO START
CRYLP:	HRL	T,B			;INIT X CNTR, BUT KEEP OLD POSN
CRXLP:	MOVEI	A,0			;ACCUMULATE CURRENT SUM IN A
	JRST	@SOUWIN			;JUMP TO PREVIOUSLY CREATED CODE
INRDON: CAML	A,D			;SEE IF NEW SUM IS BETTER
	JRST	.+3
	MOVE	D,A			;IF SO, RECORD IT
	HRRZ	E,T
	AOBJN	T,CRXLP			;SHIFT IN X, AND TRY AGAIN
	ADD	T,WSIZ1			;ADD WHATS NEEDED TO GET TO NEXT
	SOJGE	C,CRYLP			;SCANLINE, AND TRY AGAIN

	SUB	E,DESWIN		;DECOMPOSE SAVED BEST LOCATION
	IDIV	E,DWSIZ			;INTO X AND Y PARTS
	ADDB	E,@BY1			;ACTUAL LOWER Y BOUND OF BEST MATCH
	ADDB	F,@BX1			;ACTUAL LOWER X BOUND OF BEST MATCH
	ADD	F,WSIZ1			;COMPUTE UPPER X BOUND
	MOVEM	F,@BX2			;AND RETURN IT
	ADD	E,WSIZY1		;UPPER Y BOUND
	MOVEM	E,@BY2			;RETURNED

	MOVE	THIS,SOUWIN		;RETURN THE USED CORAGE
	PUSHJ	P,CORREL
	MOVE	THIS,DESWIN
	PUSHJ	P,CORREL

	MOVE	1,D			;GET READY TO RETURN VALUE OF MATCH
	ASH	1,4			;SCALE IT UP BY 2↑4
	IDIV	1,VARIAN		;NORMALIZE
	JRST	@RETAD			;AND RETURN

	PRGEND
	TITLE	NORCOR
	ENTRY	NORCOR
	EXTERN	SQR,SQRL,CORGET,CORREL
	EXTERN	TEMP

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
        BMAX←←12
	BPTAB←←13
	LINTAB←←14
%

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

X1←←A ↔ Y1←←B ↔ X2←←C ↔ Y2←←D
DEFINE AX1 <TEMP>
DEFINE AY1 <TEMP+1>
DEFINE AX2 <TEMP+2>
DEFINE AY2 <TEMP+3>
DEFINE BX1 <TEMP+4>
DEFINE BY1 <TEMP+5>
DEFINE BX2 <TEMP+6>
DEFINE BY2 <TEMP+7>
DEFINE SOUWIN <TEMP+10>
DEFINE DESWIN <TEMP+11>
DEFINE DEXSKP <TEMP+12>
DEFINE DEYSKP <TEMP+13>
DEFINE WSIZ1 <TEMP+14>
DEFINE DWSIZ <TEMP+15>
DEFINE WSIZY1 <TEMP+16>
DEFINE SIGX <TEMP+17>
DEFINE SOUSIZ <TEMP+20>
DEFINE WSIZ <TEMP+21>
DEFINE DWSIZ <TEMP+22>
DEFINE SHFT1 <TEMP+23>
DEFINE SHFT2 <TEMP+24>
DEFINE SIGXX <TEMP+25>
DEFINE RETAD <TEMP+26>
DEFINE SSIGX <TEMP+27>

NORCOR:	POP	P,RETAD
	POP	P,BX2		;A CORRELATOR. FINDS THE BEST MATCH
	POP	P,BY2		;TO RECTANGLE ARRY1(AX1:AX2,AY1:AY2)
	POP	P,BX1		;IN ARRY2(BX1:BY1,BX2:BY2)
	POP	P,BY1		;ALL ARGUMENT ARE BY REFERENCE. THE
	POP	P,ARRY2		;A'S AND B'S MAY BE ADJUSTED TO MAKE
	MOVE	X1,@BX1		;THINGS FIT
	MOVE	X2,@BX2		;  NORCOR(PIC1,AX1,AY1,AX2,AY2,
	MOVE	Y1,@BY1		;         PIC2,BX1,BY1,BX2,BY2);
	MOVE	Y2,@BY2

FIXB:	CAMLE	X1,X2		;FIRST FIX UP THE LIMITS SO
	EXCH	X1,X2		;X1≤X2, X1≥0 X2<WIDTH ETC.
	CAIGE	X1,0
	MOVEI	X1,0
	MOVE	T,LNBY(ARRY2)
	CAML	X2,T
	MOVEI	X2,-1(T)

	CAMLE	Y1,Y2		;SIMILAR FOR Y
	EXCH	Y1,Y2
	CAIGE	Y1,0
	MOVEI	Y1,0
	MOVE	T,PCLN(ARRY2)
	CAML	Y2,T
	MOVEI	Y2,-1(T)

	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	FIXB

	MOVEM	X1,@BX1
	MOVEM	X2,@BX2
	MOVEM	Y1,@BY1
	MOVEM	Y2,@BY2

	POP	P,AX2		;DO SAME FOR SOURCE WINDOW
	POP	P,AY2
	POP	P,AX1
	POP	P,AY1
	POP	P,ARRY1
	MOVE	X1,@AX1
	MOVE	X2,@AX2
	MOVE	Y1,@AY1
	MOVE	Y2,@AY2

	MOVEI	T,5		;CALCULATE SHIFTS NEEDED TO
	SUB	T,BYBI(ARRY1)	;CHANGE BOTH WINDOWS TO
	HRRZM	T,SHFT1		;FIVE BITS/SAMPLE (TO FIT THE SQUARES
	MOVEI	T,5		;TABLE)
	SUB	T,BYBI(ARRY2)
	HRRZM	T,SHFT2

FIXA:	CAMLE	X1,X2		;FIRST FIX UP THE LIMITS SO
	EXCH	X1,X2		;X1≤X2, X1≥0 X2<WIDTH ETC.
	CAIGE	X1,0
	MOVEI	X1,0
	MOVE	T,LNBY(ARRY1)
	CAML	X2,T
	MOVEI	X2,-1(T)

	CAMLE	Y1,Y2		;SIMILAR FOR Y
	EXCH	Y1,Y2
	CAIGE	Y1,0
	MOVEI	Y1,0
	MOVE	T,PCLN(ARRY1)
	CAML	Y2,T
	MOVEI	Y2,-1(T)

	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	FIXA

	MOVE	T,@BX1		;SHRINK SOURCE WINDOW SYMMETRICALLY
	SUB	T,@BX2		;UNTIL IT IS NO
	ADD	T,X2		;LARGER THAN DESTINATION WINDOW
	SUB	T,X1	
	JUMPLE	T,YSHRNK
	MOVEI	TT,1(T)
	ASHC	T,-1
	ADDI	X1,(T)
	SUBI	X2,(TT)

YSHRNK:	MOVE	T,@BY1		;SHRINK IN Y DIRECTION
	SUB	T,@BY2		;UNTIL IT IS NO
	ADD	T,Y2		;LARGER THAN DESTINATION WINDOW
	SUB	T,Y1	
	JUMPLE	T,RESTA
	MOVEI	TT,1(T)
	ASHC	T,-1
	ADDI	Y1,(T)
	SUBI	Y2,(TT)

RESTA:	MOVEM	X1,@AX1
	MOVEM	Y1,@AY1
	MOVEM	X2,@AX2
	MOVEM	Y2,@AY2

THIS←←TT ↔ SIZ←←TTT

	MOVEI	SIZ,1(X2)	;CALCULATE SIZE OF BUFFER AREA
	SUB	SIZ,X1		;FOR THE SOURCE WINDOW CODE
	MOVEM	SIZ,WSIZ1	;WILL BE X WINDOWSIZE-1
	MOVEM	SIZ,WSIZ	;IS X WINDOWSIZ
	MOVNM	SIZ,DEXSKP	;WILL BE DELTA XB - DELTA XA
	MOVEI	T,1(Y2)
	SUB	T,Y1
	MOVEM	T,WSIZY1	;WILL BE X WINDOWSIZE-1
	MOVNM	T,DEYSKP	;WIL BE DELTA YB - DELTA YA
	IMUL	SIZ,T
	MOVEM	SIZ,SOUSIZ	;SOURCE WINDOW SIZE (IN PIXELS)
	IMULI	SIZ,3
	ADDI	SIZ,1
	PUSHJ	P,CORGET	;AND MAKE THAT BUFFER
	HALT
	MOVEM	THIS,SOUWIN

	SUBI	THIS,1
	MOVN	T,T
	HRLZ	T,T
	HRRI	T,LINTAB(ARRY1)	;Y COUNTER
	ADD	T,Y1

	MOVE	0,@BX2		;FINISH UP MAKING DELTA XB -DELTA XA
	SUB	0,@BX1
	ADDI	0,1
	MOVEM	0,DWSIZ
	ADDM	0,DEXSKP
	MOVE	0,@BY2		;AND THE Y'S TOO
	SUB	0,@BY1
	ADDI	0,1
	ADDM	0,DEYSKP
	SOS	WSIZ1		;NOT TO MENTION X WINDOWSIZ-1
	SOS	WSIZY1		;AND Y WINDOWSIZ-1

	MOVE	G,[MOVN TT,0(T)]

	MOVE	E,BPTAB(ARRY1)	;BP SKELETON
	ADDI	E,-1(X1)
	MOVE	E,(E)

	SETZB	B,A			;FOR SUM OF X AND X↑2, AS EXPLND BELOW
			;DON'T FORGET! A,B,C,D ARE X1,X2,Y1,Y2 ALSO
ILYLP:	MOVE	F,E			;SETS UP IN LINE CODED
	ADD	F,(T)			;STUFF FOR THE INNER
	MOVE	TTT,WSIZ		;"LOOP" OF THE CORRELATION
ILXLP:	PUSH	THIS,G			;A SEQUENCE OF
	ADDI	G,1			; MOVN TT,POSB(T)
	ILDB	C,F			; ADD  A,SQRL+PIXEL(TT)
	LSH	C,@SHFT1
	ADD	A,SQRL(C)
	ADD	C,[ADD	A,SQRL(TT)]
	PUSH	THIS,C
	PUSH	THIS,[ADD  F,SQRL(TT)]
	SOJG	TTT,ILXLP
	ADD	G,DEXSKP
	AOBJN	T,ILYLP

	PUSH	THIS,[JRST INRDON]	;AND THE FINAL INSTR.
	
	HLRE	B,A
	ASH	B,-2
	MOVEM	B,SIGX			; SIGMA(X)
	TLZ	A,777774
	MOVEM	A,SIGXX			; SIGMA(X↑2)
	IMUL	B,B
	MOVEM	B,SSIGX			;SIGMA(X) ↑ 2

	MOVE	X1,@BX1			;MAKE THE DESTINATION
	MOVE	X2,@BX2			;WINDOW BUFFER
	MOVE	Y1,@BY1
	MOVE	Y2,@BY2
	MOVEI	SIZ,1(X2)
	SUB	SIZ,X1
	MOVEM	SIZ,DWSIZ
	MOVEI	T,1(Y2)
	SUB	T,Y1
	IMUL	SIZ,T
	PUSHJ	P,CORGET
	HALT
	MOVEM	THIS,DESWIN

	SUBI	THIS,1
	MOVN	T,T			;Y COUNTER
	HRLZ	T,T
	HRRI	T,LINTAB(ARRY2)
	ADD	T,Y1

	MOVE	E,BPTAB(ARRY2)		;BYTE POINTER SKELETON
	ADDI	E,-1(X1)		;FOR DESTINATION
	MOVE	E,(E)

BUYLP:	MOVE	F,E			;UNPACKS THE DESTINATION
	ADD	F,(T)			;WINDOW, ONE WORD/SAMPLE
	MOVE	TTT,DWSIZ
BUXLP:	ILDB	0,F
	LSH	0,@SHFT2
	PUSH	THIS,0
	SOJG	TTT,BUXLP
	AOBJN	T,BUYLP

	MOVN	B,DEXSKP		;NOW ACTUALLY CORRELATE
	SUBI	B,1

	MOVE	D,[-1.0]		;VALUE OF BEST MATCH IN D
	MOVE	E,DESWIN		;LOCATION IN E
	MOVE	C,DEYSKP		;NUMBER OF ROWS
	MOVE	T,DESWIN		;WHERE TO START
CRYLP:	HRL	T,B			;INIT X CNTR, BUT KEEP OLD POSN
CRXLP:	SETZB	A,F			;SIG((X-Y)↑(1,2))→A, SIG(Y↑(1,2))→F
	JRST	@SOUWIN			;JUMP TO PREVIOUSLY CREATED CODE
INRDON: HLRE	TT,F
	ASH	TT,-2			;EXTRACT SIG(-Y)=-SIG(Y)
	TLZ	F,777774		;AND SIG(Y↑2)
	ADD	F,SIGXX			;NOW SIG(Y↑2)+SIG(X↑2)
	IMUL	F,SOUSIZ		;NOW N*(SIG(X↑2)+SIG(Y↑2))
	TLZ	A,777774		;FORM SIG((X-Y)↑2)
	IMUL	A,SOUSIZ		;NOW N*SIG((X-Y)↑2)
	MOVN	TTT,TT			;COPY SIG(Y)
	IMUL	TTT,SIGX		;FORM SIG(Y)*SIG(X)
	ADD	A,TTT			;NOW N*SIG((X-Y)↑2)+SIG(Y)*SIG(X)
	ADD	A,TTT			;NOW N*SIG((X-Y)↑2)+2*SIG(Y)*SIG(X)
	SUB	A,F			;N*S((X-Y)↑2)+2*S(Y)*S(X)-N*(S(X↑2)+S(Y↑2))
	IMUL	TT,TT			;FORM SIG(Y)↑2
	ADD	TT,SSIGX		;NOW SIG(X)↑2+SIG(Y)↑2
	SUB	TT,F			;NOW S(X)↑2+S(Y)↑2-N*(S(X↑2)+S(Y↑2))
	FLTR	A,A			;CONVERT NUMERATOR TO FLOATING
	FLTR	TT,TT			;CONVERT DENOMINATOR TO FLOATING
	FDVR	A,TT			;FORM QUOTIENT

	CAMG	A,D			;SEE IF NEW MEASURE IS BETTER
	JRST	.+3
	MOVE	D,A			;IF SO, RECORD IT
	HRRZ	E,T
	AOBJN	T,CRXLP			;SHIFT IN X, AND TRY AGAIN
	ADD	T,WSIZ1			;ADD WHATS NEEDED TO GET TO NEXT
	SOJGE	C,CRYLP			;SCANLINE, AND TRY AGAIN

	SUB	E,DESWIN		;DECOMPOSE SAVED BEST LOCATION
	IDIV	E,DWSIZ			;INTO X AND Y PARTS
	ADDB	E,@BY1			;ACTUAL LOWER Y BOUND OF BEST MATCH
	ADDB	F,@BX1			;ACTUAL LOWER X BOUND OF BEST MATCH
	ADD	F,WSIZ1			;COMPUTE UPPER X BOUND
	MOVEM	F,@BX2			;AND RETURN IT
	ADD	E,WSIZY1		;UPPER Y BOUND
	MOVEM	E,@BY2			;RETURNED

	MOVE	THIS,SOUWIN		;RETURN THE USED CORAGE
	PUSHJ	P,CORREL
	MOVE	THIS,DESWIN
	PUSHJ	P,CORREL

	MOVE	1,D			;GET READY TO RETURN VALUE OF MATCH
	JRST	@RETAD			;AND RETURN
	PRGEND
	title pixtrn
	entry pixtrn

; procedure pixtrn(ref int source;real array tranform;ref int dest);

bytpt←0 t←1 t1←2
sxsc←3 sysc←4			;source x and y scaling
fx←5 fy←6 fs←7
dx←10 dy←11			;loop counters
my←12				;dest y scaling
src←13 trans←14 dst←15 t32←16
p←17

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
PCLN←←0 LNBY←←5 BPTAB←13 LINTAB←←14
%

SPCLN:	0
SLNBY:	0



dstmak:	outstr [asciz /Destination picture of pixtrn not initialized.
/]
	popj p,

nuldst:	outstr [asciz /Destination picture to pixtrn is null - probably not enough core.
/]
	popj p,

outsrc:	ibp bytpt			;were out of the source picture window
	sojg dx,lx			;so we do nothing
foo6:	caige dy,
	aoja dy,ly
	jrst done

pixtrn:	move src,-3(p)
	pop p,-3(p)
	pop p,dst
	pop p,trans

	jumpe dst,nuldst		;just in case of a null dest.

	skipn t,pcln(dst)
	jrst dstmak			;make dst pic (same size as src)
	soj t,
	hrrm t,foo5			;for y loop compare
	hrrm t,foo6

	push p,my
	push p,T32
	push p,lnby(dst)

	movei t,lintab(dst)
	hrrm t,foo1
	move t,bptab(dst)
	soj t,				;so we can do a idpb on byte pointer
	hrrm t,foo2

	movei t,lintab(src)
	hrrm t,foo3
	move t,bptab(src)
	hrrm t,foo4			;foo3 and foo4 make bypt pointers for src

	MOVE T,PCLN(SRC)
	MOVEM T,SPCLN
	MOVE T,LNBY(SRC)
	MOVEM T,SLNBY

	fltr sysc,pcln(src)		;scaling factors for src picture
	fltr sxsc,lnby(src)

	fltr my,pcln(dst)
	fltr t,lnby(dst)
	move src,1(trans)
	fdvr src,t
	move dst,4(trans)		;note dst and src no longer valid!!
	fdvr dst,t
	move t32,7(trans)
	fdvr t32,t

	setz dy,			;dy is y coord of dest picture
ly:
foo1:	move bytpt,lintab(dy)		;not pure code!
foo2:	add bytpt,bptab-1		;make byte pointer

	fltr fy,dy
	FADR FY,[0.5]
	fdvr fy,my
	move fx,fy			;fx ← fy ← (y+.5) /pcln(dst);
	move fs,fy

	fmpr fy,(trans)
	fadr fy,2(trans)		; fy ← t[1,1]*y + t[1,3] 
	MOVE T,SRC
	FDVR T,[2.0]
	fsbr fy,T
	fmpr fx,3(trans)
	fadr fx,5(trans)		; fx ← t[2,1]*y + t[2,3]
	MOVE T,DST
	FDVR T,[2.0]
	fsbr fx,T
	fmpr fs,6(trans)
	fadr fs,8(trans)
	fsbr fs,t32

	move dx,(p)

lx:	fadr fy,src			;fy ← y*t[1,1]+x*t[1,2]+t[1,3]
	fadr fx,dst			;fx ← y*t[2,1]+x*t[2,2]+t[2,3]
	fadr fs,t32

	MOVE T1,FY
	fdvr T1,fs
	fmpr t1,sysc			;scale for source picture
	KIfix t1,t1
	skipl t1			;check for fy in source picture
	caml t1,SPCLN
	jrst outsrc
foo3:	move t,lintab(t1)

	MOVE T1,FX
	FDVR T1,FS
	fmpr t1,sxsc
	KIfix t1,t1
	skipl t1
	caml t1,SLNBY
	jrst outsrc

foo4:	add t,bptab(t1)
	ldb t,t
	idpb t,bytpt
	sojg dx,lx
foo5:	caige dy,			;done if y ≥ pcln(dst) - 1
	aoja dy,ly

done:	pop p,0				;throw the x size away
	pop p,T32
	pop p,my

cpopj:	popj p,
	prgend
	TITLE	WIXFA1
	ENTRY	CLEAN,PASSHI
	EXTERN	SQRL,SQR
	EXTERN	MAKTAB,CORGET,CORREL
WIND:	0
HORWIN:	0
VERWIN:	0
NWIN:	0
WINSIZ:	0

STRIP:	0
MAPTAB:	0
STRIP2:	0

	A←ARRY2←ARRYO←BESTY←3 ↔ ARRY1←ARRY←CNT2←BESTX←4 ↔ DX1←VW←0
	B←T←16 ↔ C←TX←STRP←2 ↔ D←PT←PNT←5 ↔ TY←CNT←6
	SUMSQ←E←TXX←HC←7 ↔ PND←DX2←VC←10 ↔ PNC←X1←D1C←11
	PNE←Y1←D2C←12 ↔ PN1←X2←CNT1←13
	CC←Y2←TOP←14 ↔ DY1←POS←15 ↔ SUM←1 ↔ DL←17

THIS←2 ↔ SIZ←3

SEARCH PIXDEF(PIXDEF.FUN[HDR,HE])
Comment % Which replaces:
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←←13
LINTAB←←14
%

PICWID:	0 ↔ BICWID: 0
PICLIN:	0 ↔ BICLIN: 0
PICHIG:	0 ↔ BICHIG: 0
PICBIT:	0 ↔ BICBIT: 0
PICWIZ:	0 ↔ BICWIZ: 0
PICSIZ:	0 ↔ BICSIZ: 0
COLTAB:	0 ↔ BOLTAB: 0
ROWTAB:	0 ↔ BOWTAB: 0

SETUP:	0
	MOVE	T,PCWD(ARRY)		;SET "GLOBALS" FOR COMPATABILITY WITH
	MOVEM	T,PICSIZ		;OLD FORMAT
	MOVE	T,LNBYA(ARRY)
	MOVEM	T,PICWIZ
	MOVE	T,BYBI(ARRY)
	MOVEM	T,PICBIT
	MOVE	T,PCLN(ARRY)
	MOVEM	T,PICHIG
	MOVE	T,LNWD(ARRY)
	MOVEM	T,PICLIN
	MOVE	T,LNBY(ARRY)
	MOVEM	T,PICWID
	MOVE	T,BPTAB(ARRY)
	MOVEM	T,COLTAB
	MOVEI	T,LINTAB(ARRY)
	MOVEM	T,ROWTAB
	MOVE	ARRY,(T)
	JRST	@SETUP

SETUP2:	0
	MOVE	T,PCWD(ARRY2)		;SET SIMILAR VARIABLES FOR SECOND ARRAY
	MOVEM	T,BICSIZ
	MOVE	T,LNBYA(ARRY2)
	MOVEM	T,BICWIZ
	MOVE	T,BYBI(ARRY2)
	MOVEM	T,BICBIT
	MOVE	T,PCLN(ARRY2)
	MOVEM	T,BICHIG
	MOVE	T,LNWD(ARRY2)
	MOVEM	T,BICLIN
	MOVE	T,LNBY(ARRY2)
	MOVEM	T,BICWID
	MOVE	T,BPTAB(ARRY2)
	MOVEM	T,BOLTAB
	MOVEI	T,LINTAB(ARRY2)
	MOVEM	T,BOWTAB
	MOVE	ARRY2,(T)
	JRST	@SETUP2
CLN:	0
	MOVE	CNT,PICWIZ
	SUBI	CNT,2
	MOVE	A,PICHIG
	SUBI	A,2
	IMUL	CNT,A
	HRLZ	PND,PICBIT
	LSH	PND,6
	ADDI	PND,-1(ARRY)
	MOVE	PNC,PND
	ADD	PNC,PICLIN
	ILDB	B,PNC
	MOVE	PNE,PNC
	ADD	PNE,PICLIN
	ILDB	A,PNC
	MOVE	PN1,PNC
	ILDB	CC,PNC
	IBP	PND
	ILDB	D,PND
	ILDB	E,PNE
WOOP:	MOVE	C,CC
	CAMLE	B,C
	EXCH	B,C
	CAMLE	D,E
	EXCH	D,E
	CAMLE	B,D
	EXCH	B,D
	CAMLE	C,E
	EXCH	C,E
	CAMLE	C,D
	EXCH	C,D
	CAMLE	A,D
	DPB	D,PN1
	CAMGE	A,C
	DPB	C,PN1
	MOVE	PN1,PNC
	MOVE	B,A
	MOVE	A,CC
	ILDB	CC,PNC
	ILDB	D,PND
	ILDB	E,PNE
	SOJG	CNT,WOOP
	JRST	@CLN
HIPASS:	0			;HI PASS FILTERING
	MOVE	T,BOLTAB	;SET UP RIGHT INDEX TABLE REFERENCES
	SUBI	T,1
	HRRM	T,BOLF
	MOVE	T,BOWTAB
	SUBI	T,1
	HRRM	T,BOWF

	MOVE	T,MAPTAB
	HRRM	T,SMT1
	HRRM	T,SMT2
	MOVE	T,STRIP2
	HRRM	T,S2R1
	HRRM	T,S2R2
	HRRM	T,S2R3
	HRRM	T,S2R4
	HRRM	T,S2R5
	SUBI	T,1
	HRRM	T,CO

	MOVEI	E,1
	ASH	E,@PICBIT
	MOVE	C,E
	ASH	C,1
	SUBI	E,1
	MOVE	CNT,E
	HRRM	CNT,TABTS
	HRRM	CNT,TABTS+1
	ASH	CNT,-1
	HRRM	CNT,TABL
	MOVN	E,E
TABL:	HRREI	VW,100(E)
	CAIGE	VW,0
	MOVEI	VW,0
TABTS:	CAILE	VW,77
	MOVEI	VW,77
SMT1:	MOVEM	VW,MAPTAB(E)
	ADDI	E,1
	SOJG	C,TABL
BRK:	HRL	E,ARRY1
	HRR	E,ARRY2
	MOVE	C,ARRY2
	ADD	C,PICSIZ
	SUBI	C,1
	BLT	E,(C)
	MOVN	CNT,PICWIZ
	HRLZ	CNT,CNT
	HRLZ	PNT,PICBIT
	LSH	PNT,6
	ADDI	PNT,-1(ARRY)
	MOVE	PN1,PNT
	MOVE	B,CNT
CL:	ILDB	VW,PNT
S2R1:	MOVEM	VW,STRIP2(B)
	AOBJN	B,CL
	MOVE	E,WIND
	SOJLE	E,NADD
CN:	MOVE	B,CNT
CM:	ILDB	VW,PNT
S2R2:	ADDM	VW,STRIP2(B)
	AOBJN	B,CM
	SOJG	E,CN
NADD:	MOVE	DL,WIND
	ASH	DL,-1
BOLF:	MOVE	ARRY2,BOLTAB-1(DL)	;REPLACED BY REAL BOLTAB ADDRESS
BOWF:	ADD	ARRY2,BOWTAB-1(DL)	;DITTO FOR BOWTAB
	MOVE	C,WIND
	SUB	C,PICWIZ
	HRLZ	C,C
S2R3:	MOVEI	VW,STRIP2
	ADD	VW,WIND
	HRRM	VW,SUMST
	MOVE	E,PICHIG
	SUB	E,WIND
CR:	SETZ	SUM,
	MOVE	B,WIND
CO:	ADD	SUM,STRIP2-1(B)
	SOJG	B,CO
	MOVE	B,C
	MOVE	PND,PICLIN
	ADDB	PND,ARRY2
CP:	MOVE	CC,WINSIZ
	IDIVM	SUM,CC
	ILDB	DY1,PND
SHFST:	SUB	DY1,CC
SMT2:	MOVE	DY1,MAPTAB(DY1)
	DPB	DY1,PND
S2R4:	SUB	SUM,STRIP2(B)
SUMST:	ADD	SUM,STRIP2(B)		;CHANGED TO STRIP+<WIND>
	AOBJN	B,CP
	MOVE	B,CNT
CQ:	ILDB	CC,PN1
	ILDB	VW,PNT
	SUB	VW,CC
S2R5:	ADDM	VW,STRIP2(B)
	AOBJN	B,CQ
	SOJGE	E,CR
	JRST	@HIPASS
;***** WIXFA1 SAIL INTERFACE ********

	P←17

ACS12:	0
ACS16:	0
ACS17:	0
RETAD:	0

ACS:	BLOCK	20
ARN1:	0
ARN2:	0
PASSHI:	MOVEM	12,ACS12
	MOVEM	16,ACS16
	POP	P,RETAD
	POP	P,ARRY2
	POP	P,WIND
	POP	P,ARRY1
	HRL	T,ARRY1
	HRR	T,ARRY2
	BLT	T,13(ARRY2)
	MOVE	T,ARRY2
	SUB	T,ARRY1
	ADDM	T,13(ARRY2)
	MOVEM	ARRY1,ARN1
	MOVEM	ARRY2,ARN2
	PUSH	P,ARRY2
	PUSHJ	P,MAKTAB
	MOVE	ARRY1,ARN1
	MOVE	ARRY2,ARN2
	JSR	SETUP
	JSR	SETUP2

	MOVE	1,PICWID	;SET UP WINDOW PARAMETERS
	SUBI	1,1
	IDIV	1,WIND
	MOVEM	1,HORWIN
	MOVE	1,PICHIG
	SUBI	1,1
	IDIV	1,WIND
	MOVEM	1,VERWIN
	IMUL	1,HORWIN
	MOVEM	1,NWIN
	MOVE	1,WIND
	IMUL	1,1
	MOVEM	1,WINSIZ

	MOVEM	16,ACS+16	;SET UP UNPACKING AND MAP TABLE AREAS
	MOVEI	16,ACS
	BLT	16,ACS+15
	MOVEI	SIZ,1
	ASH	SIZ,@PICBIT
	MOVEM	SIZ,MAPTAB
	ASH	SIZ,1
	PUSHJ	17,CORGET
	HALT
	MOVEM	THIS,STRIP
	ADDM	THIS,MAPTAB
	MOVE	SIZ,PICWIZ
	PUSHJ	17,CORGET
	HALT
	MOVEM	THIS,STRIP2
	HRLZI	16,ACS
	BLT	16,16

	MOVEM	17,ACS17
	JSR	HIPASS
	MOVE	17,ACS17
	MOVE	16,ACS16
	MOVE	12,ACS12

	MOVE	THIS,STRIP
	PUSHJ	17,CORREL
	MOVE	THIS,STRIP2
	PUSHJ	17,CORREL

	JRST	@RETAD
CLEAN:	MOVEM	12,ACS12
	MOVEM	16,ACS16
	POP	P,RETAD
	POP	P,ARRY
	JSR	SETUP
	MOVEM	17,ACS17
	JSR	CLN
	MOVE	12,ACS12
	MOVE	16,ACS16
	MOVE	17,ACS17
	JRST	@RETAD

	PRGEND
	TITLE	TEMP
	ENTRY	SQR,SQRL,TEMP

TEMP:	BLOCK	50		;TEMPORARY STORAGE FOR STUFF

	FOR I←-40,-1,1 { I*4000000+I*I
				}
SQRL:	FOR I←0,40,1   { I*4000000+I*I
				}

	FOR I←-200,-1,1 { I*I
				}
SQR:	FOR I←0,200,1   { I*I
				}
	END